Theory Ids
theory "Ids"
imports Complex_Main
begin
section ‹Identifier locale›
text ‹The differential dynamic logic formalization is parameterized by the type of identifiers.
The identifier type(s) must be finite and have at least 3-4 distinct elements.
Distinctness is required for soundness of some axioms. ›
locale ids =
fixes vid1 :: "('sz::{finite,linorder})"
fixes vid2 :: 'sz
fixes vid3 :: 'sz
fixes fid1 :: "('sf::finite)"
fixes fid2 :: 'sf
fixes fid3 :: 'sf
fixes pid1 :: "('sc::finite)"
fixes pid2 :: 'sc
fixes pid3 :: 'sc
fixes pid4 :: 'sc
assumes vne12:"vid1 ≠ vid2"
assumes vne23:"vid2 ≠ vid3"
assumes vne13:"vid1 ≠ vid3"
assumes fne12:"fid1 ≠ fid2"
assumes fne23:"fid2 ≠ fid3"
assumes fne13:"fid1 ≠ fid3"
assumes pne12:"pid1 ≠ pid2"
assumes pne23:"pid2 ≠ pid3"
assumes pne13:"pid1 ≠ pid3"
assumes pne14:"pid1 ≠ pid4"
assumes pne24:"pid2 ≠ pid4"
assumes pne34:"pid3 ≠ pid4"
context ids begin
lemma id_simps:
"(vid1 = vid2) = False" "(vid2 = vid3) = False" "(vid1 = vid3) = False"
"(fid1 = fid2) = False" "(fid2 = fid3) = False" "(fid1 = fid3) = False"
"(pid1 = pid2) = False" "(pid2 = pid3) = False" "(pid1 = pid3) = False"
"(pid1 = pid4) = False" "(pid2 = pid4) = False" "(pid3 = pid4) = False"
"(vid2 = vid1) = False" "(vid3 = vid2) = False" "(vid3 = vid1) = False"
"(fid2 = fid1) = False" "(fid3 = fid2) = False" "(fid3 = fid1) = False"
"(pid2 = pid1) = False" "(pid3 = pid2) = False" "(pid3 = pid1) = False"
"(pid4 = pid1) = False" "(pid4 = pid2) = False" "(pid4 = pid3) = False"
using vne12 vne23 vne13 fne12 fne23 fne13 pne12 pne23 pne13 pne14 pne24 pne34 by auto
end
end
Theory Lib
theory Lib
imports
Ordinary_Differential_Equations.ODE_Analysis
begin
section ‹Generic Mathematical Lemmas›
text‹General lemmas that don't have anything to do with dL specifically and could be fit for
general-purpose libraries, mostly dealing with derivatives, ODEs and vectors.›
lemma vec_extensionality:"(⋀i. v$i = w$i) ⟹ (v = w)"
by (simp add: vec_eq_iff)
lemma norm_axis: "norm (axis i x) = norm x"
unfolding axis_def norm_vec_def
unfolding L2_set_def
by(clarsimp simp add: if_distrib[where f=norm] if_distrib[where f="λx. x⇧2"] sum.If_cases)
lemma bounded_linear_axis: "bounded_linear (axis i)"
proof
show "axis i (x + y) = axis i x + axis i y" "axis i (r *⇩R x) = r *⇩R axis i x" for x y :: "'a" and r
by (auto simp: vec_eq_iff axis_def)
show "∃K. ∀x::'a. norm (axis i x) ≤ norm x * K"
by (auto simp add: norm_axis intro!: exI[of _ 1])
qed
lemma bounded_linear_vec:
fixes f::"('a::finite) ⇒ 'b::real_normed_vector ⇒ 'c::real_normed_vector"
assumes bounds:"⋀i. bounded_linear (f i)"
shows "bounded_linear (λx. χ i. f i x)"
proof unfold_locales
fix r x y
interpret bounded_linear "f i" for i by fact
show "(χ i. f i (x + y)) = (χ i. f i x) + (χ i. f i y)"
by (vector add)
show "(χ i. f i (r *⇩R x)) = r *⇩R (χ i. f i x)"
by (vector scaleR)
obtain K where "norm (f i x) ≤ norm x * K i" for x i
using bounded by metis
then have "norm (χ i. f i x) ≤ norm x * (∑i∈UNIV. K i)" (is "?lhs ≤ ?rhs") for x
unfolding sum_distrib_left
unfolding norm_vec_def
by (auto intro!: L2_set_le_sum_abs[THEN order_trans] sum_mono simp: abs_mult)
then show "∃K. ∀x. norm (χ i. f i x) ≤ norm x * K"
by blast
qed
lift_definition blinfun_vec::"('a::finite ⇒ 'b::real_normed_vector ⇒⇩L real) ⇒ 'b ⇒⇩L (real ^ 'a)" is "(λ(f::('a ⇒ 'b ⇒ real)) (x::'b). χ (i::'a). f i x)"
by(rule bounded_linear_vec, simp)
lemmas blinfun_vec_simps[simp] = blinfun_vec.rep_eq
lemma continuous_blinfun_vec:"(⋀i. continuous_on UNIV (blinfun_apply (g i))) ⟹ continuous_on UNIV (blinfun_vec g)"
by (simp add: continuous_on_vec_lambda)
lemma blinfun_elim:"⋀g. (blinfun_apply (blinfun_vec g)) = (λx. χ i. g i x)"
using blinfun_vec.rep_eq by auto
lemma sup_plus:
fixes f g::"('b::metric_space) ⇒ real"
assumes nonempty:"R ≠ {}"
assumes bddf:"bdd_above (f ` R)"
assumes bddg:"bdd_above (g ` R)"
shows "(SUP x∈R. f x + g x) ≤ (SUP x∈R. f x) + (SUP x∈R. g x)"
proof -
have bddfg:"bdd_above((λx. f x + g x ) ` R)"
using bddf bddg apply (auto simp add: bdd_above_def)
using add_mono_thms_linordered_semiring(1) by blast
have eq:"(SUP x∈R. f x + g x) ≤ (SUP x∈R. f x) + (SUP x∈R. g x)
⟷ (∀x∈R. (f x + g x) ≤ (SUP x∈R. f x) + (SUP x∈R. g x))"
apply(rule cSUP_le_iff)
subgoal by (rule nonempty)
subgoal by (rule bddfg)
done
have fs:"⋀x. x ∈ R ⟹ f x ≤ (SUP x∈R. f x)"
using bddf
by (simp add: cSUP_upper)
have gs:"⋀x. x ∈ R ⟹ g x ≤ (SUP x∈R. g x)"
using bddg
by (simp add: cSUP_upper)
have "(∀x∈R. (f x + g x) ≤ (SUP x∈R. f x) + (SUP x∈R. g x))"
apply auto
subgoal for x using fs[of x] gs[of x] by auto
done
then show ?thesis by (auto simp add: eq)
qed
lemma continuous_blinfun_vec':
fixes f::"'a::{finite,linorder} ⇒ 'b::{metric_space, real_normed_vector,abs} ⇒ 'b ⇒⇩L real"
fixes S::"'b set"
assumes conts:"⋀i. continuous_on UNIV (f i)"
shows "continuous_on UNIV (λx. blinfun_vec (λ i. f i x))"
proof (auto simp add: LIM_def continuous_on_def)
fix x1 and ε::real
assume ε:"0 < ε"
let ?n = "card (UNIV::'a set)"
have conts':" ⋀i x1 ε. 0 < ε ⟹ ∃δ>0. ∀x2. x2 ≠ x1 ∧ dist x2 x1 < δ ⟶ dist (f i x2) (f i x1) < ε"
using conts by(auto simp add: LIM_def continuous_on_def)
have conts'':"⋀i. ∃δ>0. ∀x2. x2 ≠ x1 ∧ dist x2 x1 < δ ⟶ dist (f i x2) (f i x1) < (ε/?n)"
subgoal for i using conts'[of "ε / ?n" x1 i] ε by auto done
let ?f = "(λx. blinfun_vec (λ i. f i x))"
let ?Pδ = "(λ i δ. (δ>0 ∧ (∀x2. x2 ≠ x1 ∧ dist x2 x1 < δ ⟶ dist (f i x2) (f i x1) < (ε/?n))))"
let ?δi = "(λi. SOME δ. ?Pδ i δ)"
have Ps:"⋀i. ∃δ. ?Pδ i δ" using conts'' by auto
have Pδi:"⋀i. ?Pδ i (?δi i)"
subgoal for i using someI[of "?Pδ i" ] Ps[of i] by auto done
have finU:"finite (UNIV::'a set)" by auto
let ?δ = "linorder_class.Min (?δi ` UNIV)"
have δ0s:"⋀i. ?δi i > 0" using Pδi by blast
then have δ0s':"⋀i. 0 < ?δi i" by auto
have bounds:"bdd_below (?δi ` UNIV)"
unfolding bdd_below_def
using δ0s less_eq_real_def by blast
have δs:"⋀i. ?δ ≤ ?δi i"
using bounds cINF_lower[of ?δi] by auto
have finite:"finite ((?δi ` UNIV))" by auto
have nonempty:"((?δi ` UNIV)) ≠ {}" by auto
have δ:"?δ > 0 " using Min_gr_iff[OF finite nonempty] δ0s'
by blast
have conts''':"⋀i x2. x2 ≠ x1 ⟹ dist x2 x1 < ?δi i ⟹ dist (f i x2) (f i x1) < (ε/?n)"
subgoal for i x2
using conts''[of i] apply auto
subgoal for δ
apply(erule allE[where x=x2])
using Pδi δs[of i] apply (auto simp add: δs[of i])
done
done
done
have "⋀x2. x2 ≠ x1 ∧ dist x2 x1 < ?δ ⟹ dist (blinfun_vec (λi. f i x2)) (blinfun_vec (λi. f i x1)) < ε"
proof (auto)
fix x2
assume ne:"x2 ≠ x1"
assume dist:"∀i. dist x2 x1 < ?δi i"
have dists:"⋀i. dist x2 x1 < ?δi i"
subgoal for i using dist δs[of i] by auto done
have euclid:"⋀y. norm(?f x1 y - ?f x2 y) = (L2_set (λi. norm(f i x1 y - f i x2 y)) UNIV)"
by (simp add: norm_vec_def)
have finite:"finite (UNIV::'a set)" by auto
have nonempty: "(UNIV::'a set) ≠ {}" by auto
have nonemptyB: "(UNIV::'b set) ≠ {}" by auto
have nonemptyR: "(UNIV::real set) ≠ {}" by auto
have SUP_leq:"⋀f::('b ⇒ real). ⋀ g::('b ⇒ real). ⋀ S::'b set. S ≠ {} ⟹ bdd_above (g ` S) ⟹ (⋀x. x ∈ (S::'b set) ⟹ ((f x)::real) ≤ ((g x)::real)) ⟹ (SUP x∈S. f x) ≤ (SUP x∈S. g x)"
by(rule cSup_mono, auto)
have SUP_sum_comm':"⋀R S f . finite (S::'a set) ⟹ (R::'d::metric_space set) ≠ {} ⟹
(⋀i x. ((f i x)::real) ≥ 0) ⟹
(⋀i. bdd_above (f i ` R)) ⟹
(SUP x∈R . (∑i ∈ S. f i x)) ≤ (∑i ∈ S. (SUP x∈R. f i x))"
proof -
fix R::"'d set" and S ::"('a)set" and f ::"'a ⇒ 'd ⇒ real"
assume non:"R ≠ {} "
assume fin:"finite S"
assume every:"(⋀i x. 0 ≤ f i x)"
assume bddF:"⋀i. bdd_above (f i ` R)"
then have bddF':"⋀i. ∃M. ∀x ∈R. f i x ≤ M "
unfolding bdd_above_def by auto
let ?boundP = "(λi M. ∀x ∈R. f i x ≤ M)"
let ?bound = "(λi::'a. SOME M. ∀x ∈R. f i x ≤ M)"
have "⋀i. ∃M. ?boundP i M" using bddF' by auto
then have each_bound:"⋀i. ?boundP i (?bound i)"
subgoal for i using someI[of "?boundP i"] by blast done
let ?bigBound = "(λF. ∑i∈F. (?bound i))"
have bddG:"⋀i::'a. ⋀F. bdd_above ((λx. ∑i∈F. f i x) ` R)"
subgoal for i F
using bddF[of i] unfolding bdd_above_def apply auto
apply(rule exI[where x="?bigBound F"])
subgoal for M
apply auto
subgoal for x
using each_bound by (simp add: sum_mono)
done
done
done
show "?thesis R S f" using fin assms
proof (induct)
case empty
have "((SUP x∈R. ∑i∈{}. f i x)::real) ≤ (∑i∈{}. SUP a∈R. f i a)" by (simp add: non)
then show ?case by auto
next
case (insert x F)
have "((SUP xa∈R. ∑i∈insert x F. f i xa)::real) ≤ (SUP xa∈R. f x xa + (∑i∈F. f i xa))"
using insert.hyps(2) by auto
moreover have "... ≤ (SUP xa∈ R. f x xa) + (SUP xa∈R. (∑i∈F. f i xa))"
by(rule sup_plus, rule non, rule bddF, rule bddG)
moreover have "... ≤ (SUP xa∈ R. f x xa) + (∑i∈F. SUP a∈R. f i a)"
using add_le_cancel_left conts insert.hyps(3) by blast
moreover have "... ≤ (∑i∈(insert x F). SUP a∈R. f i a)"
by (simp add: insert.hyps(2))
ultimately have "((SUP xa∈R. ∑i∈insert x F. f i xa)::real) ≤ (∑i∈(insert x F). SUP a∈R. f i a)"
by linarith
then show ?case by auto
qed
qed
have SUP_sum_comm:"⋀R S y1 y2 . finite (S::'a set) ⟹ (R::'b set) ≠ {} ⟹ (SUP x∈R . (∑i ∈ S. norm(f i y1 x - f i y2 x)/norm(x))) ≤ (∑i ∈ S. (SUP x∈R. norm(f i y1 x - f i y2 x)/norm(x)))"
apply(rule SUP_sum_comm')
apply(auto)[3]
proof (unfold bdd_above_def)
fix R S y1 y2 i
{ fix rr :: "real ⇒ real"
obtain bb :: "real ⇒ ('b ⇒ real) ⇒ 'b set ⇒ 'b" where
ff1: "⋀r f B. r ∉ f ` B ∨ f (bb r f B) = r"
by moura
{ assume "∃r. ¬ rr r ≤ norm (f i y1 - f i y2)"
then have "∃r. norm (blinfun_apply (f i y1) (bb (rr r) (λb. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) R) - blinfun_apply (f i y2) (bb (rr r) (λb. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) R)) / norm (bb (rr r) (λb. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) R) ≠ rr r"
by (metis (no_types) le_norm_blinfun minus_blinfun.rep_eq)
then have "∃r. rr r ≤ r ∨ rr r ∉ (λb. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) ` R"
using ff1 by meson }
then have "∃r. rr r ≤ r ∨ rr r ∉ (λb. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) ` R"
by blast }
then show "∃r. ∀ra∈(λb. norm (blinfun_apply (f i y1) b - blinfun_apply (f i y2) b) / norm b) ` R. ra ≤ r"
by meson
qed
have SUM_leq:"⋀S::('a) set. ⋀ f g ::('a ⇒ real). S ≠ {} ⟹ finite S ⟹ (⋀x. x ∈ S ⟹ f x < g x) ⟹ (∑x∈S. f x) < (∑x∈S. g x)"
by(rule sum_strict_mono, auto)
have L2:"⋀f S. L2_set (λx. norm(f x)) S ≤ (∑x ∈ S. norm(f x))"
using L2_set_le_sum norm_ge_zero by metis
have L2':"⋀y. (L2_set (λi. norm(f i x1 y - f i x2 y)) UNIV)/norm(y) ≤ (∑i∈UNIV. norm(f i x1 y - f i x2 y))/norm(y)"
subgoal for y
using L2[of "(λ x. f x x1 y - f x x2 y)" UNIV]
by (auto simp add: divide_right_mono)
done
have "⋀i. (SUP y∈UNIV. norm((f i x1 - f i x2) y)/norm(y)) = norm(f i x1 - f i x2)"
by (simp add: onorm_def norm_blinfun.rep_eq)
then have each_norm:"⋀i. (SUP y∈UNIV. norm(f i x1 y - f i x2 y)/norm(y)) = norm(f i x1 - f i x2)"
by (metis (no_types, lifting) SUP_cong blinfun.diff_left)
have bounded_linear:"⋀i. bounded_linear (λy. f i x1 y - f i x2 y)"
by (simp add: blinfun.bounded_linear_right bounded_linear_sub)
have each_bound:"⋀i. bdd_above ((λy. norm(f i x1 y - f i x2 y)/norm(y)) ` UNIV)"
using bounded_linear unfolding bdd_above_def
proof -
fix i :: 'a
{ fix rr :: "real ⇒ real"
have "⋀a r. norm (blinfun_apply (f a x1) r - blinfun_apply (f a x2) r) / norm r ≤ norm (f a x1 - f a x2)"
by (metis le_norm_blinfun minus_blinfun.rep_eq)
then have "⋀r R. r ∉ (λr. norm (blinfun_apply (f i x1) r - blinfun_apply (f i x2) r) / norm r) ` R ∨ r ≤ norm (f i x1 - f i x2)"
by blast
then have "∃r. rr r ≤ r ∨ rr r ∉ range (λr. norm (blinfun_apply (f i x1) r - blinfun_apply (f i x2) r) / norm r)"
by blast }
then show "∃r. ∀ra∈range (λr. norm (blinfun_apply (f i x1) r - blinfun_apply (f i x2) r) / norm r). ra ≤ r"
by meson
qed
have bdd_above:"(bdd_above ((λy. (∑i∈UNIV. norm(f i x1 y - f i x2 y)/norm(y))) ` UNIV))"
using each_bound unfolding bdd_above_def apply auto
proof -
assume each:"(⋀i. ∃M. ∀x. ¦blinfun_apply (f i x1) x - blinfun_apply (f i x2) x¦ / norm x ≤ M)"
let ?boundP = "(λi M. ∀x. ¦blinfun_apply (f i x1) x - blinfun_apply (f i x2) x¦ / norm x ≤ M)"
let ?bound = "(λi. SOME x. ?boundP i x)"
have bounds:"⋀i. ?boundP i (?bound i)"
subgoal for i using each someI[of "?boundP i"] by blast done
let ?bigBound = "∑i∈(UNIV::'a set). ?bound i"
show "∃M. ∀x. (∑i∈UNIV. ¦blinfun_apply (f i x1) x - blinfun_apply (f i x2) x¦ / norm x) ≤ M"
apply(rule exI[where x= ?bigBound])
by(auto simp add: bounds sum_mono)
qed
have bdd_above:"(bdd_above ((λy. (∑i∈UNIV. norm(f i x1 y - f i x2 y))/norm(y)) ` UNIV))"
using bdd_above unfolding bdd_above_def apply auto
proof -
fix M :: real
assume a1: "∀x. (∑i∈UNIV. ¦blinfun_apply (f i x1) x - blinfun_apply (f i x2) x¦ / norm x) ≤ M"
{ fix bb :: "real ⇒ 'b"
have "⋀b. (∑a∈UNIV. ¦blinfun_apply (f a x1) b - blinfun_apply (f a x2) b¦) / norm b ≤ M"
using a1 by (simp add: sum_divide_distrib)
then have "∃r. (∑a∈UNIV. ¦blinfun_apply (f a x1) (bb r) - blinfun_apply (f a x2) (bb r)¦) / norm (bb r) ≤ r"
by blast }
then show "∃r. ∀b. (∑a∈UNIV. ¦blinfun_apply (f a x1) b - blinfun_apply (f a x2) b¦) / norm b ≤ r"
by meson
qed
have "dist (?f x2) (?f x1) = norm((?f x2) - (?f x1))"
by (simp add: dist_blinfun_def)
moreover have "... = (SUP y∈UNIV. norm(?f x1 y - ?f x2 y)/norm(y))"
by (metis (no_types, lifting) SUP_cong blinfun.diff_left norm_blinfun.rep_eq norm_minus_commute onorm_def)
moreover have "... = (SUP y∈UNIV. (L2_set (λi. norm(f i x1 y - f i x2 y)) UNIV)/norm(y))"
using euclid by auto
moreover have "... ≤ (SUP y∈UNIV. (∑i∈UNIV. norm(f i x1 y - f i x2 y))/norm(y))"
using L2' SUP_cong SUP_leq bdd_above by auto
moreover have "... = (SUP y∈UNIV. (∑i∈UNIV. norm(f i x1 y - f i x2 y)/norm(y)))"
by (simp add: sum_divide_distrib)
moreover have "... ≤ (∑i∈UNIV. (SUP y∈UNIV. norm(f i x1 y - f i x2 y)/norm(y)))"
by(rule SUP_sum_comm[OF finite nonemptyB, of x1 x2])
moreover have "... = (∑i∈UNIV. norm(f i x1 - f i x2))"
using each_norm by simp
moreover have "... = (∑i∈UNIV. dist(f i x1) (f i x2))"
by (simp add: dist_blinfun_def)
moreover have "... < (∑i∈(UNIV::'a set). ε / ?n)"
using conts'''[OF ne dists] using SUM_leq[OF nonempty, of "(λi. dist (f i x1) (f i x2))" "(λi. ε / ?n)"]
by (simp add: dist_commute)
moreover have "... = ε"
by(auto)
ultimately show "dist (?f x2) (?f x1) < ε"
by linarith
qed
then show "∃s>0. ∀x2. x2 ≠ x1 ∧ dist x2 x1 < s ⟶ dist (blinfun_vec (λi. f i x2)) (blinfun_vec (λi. f i x1)) < ε"
using δ by blast
qed
lemma has_derivative_vec[derivative_intros]:
assumes "⋀i. ((λx. f i x) has_derivative (λh. f' i h)) F"
shows "((λx. χ i. f i x) has_derivative (λh. χ i. f' i h)) F"
proof -
have *: "(χ i. f i x) = (∑i∈UNIV. axis i (f i x))" "(χ i. f' i x) = (∑i∈UNIV. axis i (f' i x))" for x
by (simp_all add: axis_def sum.If_cases vec_eq_iff)
show ?thesis
unfolding *
by (intro has_derivative_sum bounded_linear.has_derivative[OF bounded_linear_axis] assms)
qed
lemma has_derivative_proj:
fixes j::"('a::finite)"
fixes f::"'a ⇒ real ⇒ real"
assumes assm:"((λx. χ i. f i x) has_derivative (λh. χ i. f' i h)) F"
shows "((λx. f j x) has_derivative (λh. f' j h)) F"
proof -
have bounded_proj:"bounded_linear (λ x::(real^'a). x $ j)"
by (simp add: bounded_linear_vec_nth)
show "?thesis"
using bounded_linear.has_derivative[OF bounded_proj, of "(λx. χ i. f i x)" "(λh. χ i. f' i h)", OF assm]
by auto
qed
lemma has_derivative_proj':
fixes i::"'a::finite"
shows "∀x. ((λ x. x $ i) has_derivative (λx::(real^'a). x $ i)) (at x)"
proof -
have bounded_proj:"bounded_linear (λ x::(real^'a). x $ i)"
by (simp add: bounded_linear_vec_nth)
show "?thesis"
using bounded_proj unfolding has_derivative_def by auto
qed
lemma constant_when_zero:
fixes v::"real ⇒ (real, 'i::finite) vec"
assumes x0: "(v t0) $ i = x0"
assumes sol: "(v solves_ode f) T S"
assumes f0: "⋀s x. s ∈ T ⟹ f s x $ i = 0"
assumes t0:"t0 ∈ T"
assumes t:"t ∈ T"
assumes convex:"convex T"
shows "v t $ i = x0"
proof -
from solves_odeD[OF sol]
have deriv: "(v has_vderiv_on (λt. f t (v t))) T" by simp
then have "((λt. v t $ i) has_vderiv_on (λt. 0)) T"
using f0
by (auto simp: has_vderiv_on_def has_vector_derivative_def cart_eq_inner_axis
intro!: derivative_eq_intros)
from has_vderiv_on_zero_constant[OF convex this]
obtain c where c:"⋀x. x ∈ T ⟹ v x $ i = c" by blast
with x0 have "c = x0" "v t $ i = c"
using t t0 c x0 by blast+
then show ?thesis by simp
qed
lemma
solves_ode_subset:
assumes x: "(x solves_ode f) T X"
assumes s: "S ⊆ T"
shows "(x solves_ode f) S X"
apply(rule solves_odeI)
using has_vderiv_on_subset s solves_ode_vderivD x apply force
using assms by (auto intro!: solves_odeI dest!: solves_ode_domainD)
lemma
solves_ode_supset_range:
assumes x: "(x solves_ode f) T X"
assumes y: "X ⊆ Y"
shows "(x solves_ode f) T Y"
apply(rule solves_odeI)
using has_vderiv_on_subset y solves_ode_vderivD x apply force
using assms by (auto intro!: solves_odeI dest!: solves_ode_domainD)
lemma
usolves_ode_subset:
assumes x: "(x usolves_ode f from t0) T X"
assumes s: "S ⊆ T"
assumes t0: "t0 ∈ S"
assumes S: "is_interval S"
shows "(x usolves_ode f from t0) S X"
proof (rule usolves_odeI)
note usolves_odeD[OF x]
show "(x solves_ode f) S X" by (rule solves_ode_subset; fact)
show "t0 ∈ S" "is_interval S" by(fact+)
fix z t
assume s: "{t0 -- t} ⊆ S" and z: "(z solves_ode f) {t0 -- t} X" and z0: "z t0 = x t0"
then have "t0 ∈ {t0 -- t}" "is_interval {t0 -- t}"
by auto
moreover note s
moreover have "(z solves_ode f) {t0--t} X"
using solves_odeD[OF z] ‹S ⊆ T›
by (intro solves_ode_subset_range[OF z]) force
moreover note z0
moreover have "t ∈ {t0 -- t}" by simp
ultimately show "z t = x t"
by (meson ‹⋀z ta T'. ⟦t0 ∈ T'; is_interval T'; T' ⊆ T; (z solves_ode f) T' X; z t0 = x t0; ta ∈ T'⟧ ⟹ z ta = x ta› assms(2) dual_order.trans)
qed
lemma example:
fixes x t::real and i::"('sz::finite)"
assumes "t > 0"
shows "x = (ll_on_open.flow UNIV (λt. λx. χ (i::('sz::finite)). 0) UNIV 0 (χ i. x) t) $ i"
proof -
let ?T = UNIV
let ?f = "(λt. λx. χ i::('sz::finite). 0)"
let ?X = UNIV
let ?t0.0 = 0
let ?x0.0 = "χ i::('sz::finite). x"
interpret ll: ll_on_open "UNIV" "(λt x. χ i::('sz::finite). 0)" UNIV
using gt_ex
by unfold_locales
(auto simp: interval_def continuous_on_def local_lipschitz_def intro!: lipschitz_intros)
have foo1:"?t0.0 ∈ ?T" by auto
have foo2:"?x0.0 ∈ ?X" by auto
let ?v = "ll.flow ?t0.0 ?x0.0"
from ll.flow_solves_ode[OF foo1 foo2]
have solves:"(ll.flow ?t0.0 ?x0.0 solves_ode ?f) (ll.existence_ivl ?t0.0 ?x0.0) ?X" by (auto)
then have solves:"(?v solves_ode ?f) (ll.existence_ivl ?t0.0 ?x0.0) ?X" by auto
have thex0: "(?v ?t0.0) $ (i::('sz::finite)) = x" by auto
have sol_help: "(?v solves_ode ?f) (ll.existence_ivl ?t0.0 ?x0.0) ?X" using solves by auto
have ivl:"ll.existence_ivl ?t0.0 ?x0.0 = UNIV"
by (rule ll.existence_ivl_eq_domain)
(auto intro!: exI[where x=0] simp: vec_eq_iff)
have sol: "(?v solves_ode ?f) UNIV ?X" using solves ivl by auto
have thef0: "⋀t x. ?f t x $ i = 0" by auto
from constant_when_zero [OF thex0 sol thef0]
have "?v t $ i = x"
by auto
thus ?thesis by auto
qed
lemma MVT_ivl:
fixes f::"'a::ordered_euclidean_space⇒'b::ordered_euclidean_space"
assumes fderiv: "⋀x. x ∈ D ⟹ (f has_derivative J x) (at x within D)"
assumes J_ivl: "⋀x. x ∈ D ⟹ J x u ≥ J0"
assumes line_in: "⋀x. x ∈ {0..1} ⟹ a + x *⇩R u ∈ D"
shows "f (a + u) - f a ≥ J0"
proof -
from MVT_corrected[OF fderiv line_in] obtain t where
t: "t∈Basis → {0<..<1}" and
mvt: "f (a + u) - f a = (∑i∈Basis. (J (a + t i *⇩R u) u ∙ i) *⇩R i)"
by auto
note mvt
also have "… ≥ J0"
proof -
have J: "⋀i. i ∈ Basis ⟹ J0 ≤ J (a + t i *⇩R u) u"
using J_ivl t line_in by (auto simp: Pi_iff)
show ?thesis
using J
unfolding atLeastAtMost_iff eucl_le[where 'a='b]
by auto
qed
finally show ?thesis .
qed
lemma MVT_ivl':
fixes f::"'a::ordered_euclidean_space⇒'b::ordered_euclidean_space"
assumes fderiv: "(⋀x. x ∈ D ⟹ (f has_derivative J x) (at x within D))"
assumes J_ivl: "⋀x. x ∈ D ⟹ J x (a - b) ≥ J0"
assumes line_in: "⋀x. x ∈ {0..1} ⟹ b + x *⇩R (a - b) ∈ D"
shows "f a ≥ f b + J0"
proof -
have "f (b + (a - b)) - f b ≥ J0"
apply (rule MVT_ivl[OF fderiv ])
apply assumption
apply (rule J_ivl) apply assumption
using line_in
apply (auto simp: diff_le_eq le_diff_eq ac_simps)
done
thus ?thesis
by (auto simp: diff_le_eq le_diff_eq ac_simps)
qed
end
Theory Syntax
theory Syntax
imports
Complex_Main
"Ids"
begin
section ‹Syntax›
text ‹
We define the syntax of dL terms, formulas and hybrid programs. As in
CADE'15, the syntax allows arbitrarily nested differentials. However,
the semantics of such terms is very surprising (e.g. (x')' is zero in
every state), so we define predicates dfree and dsafe to describe terms
with no differentials and no nested differentials, respectively.
In keeping with the CADE'15 presentation we currently make the simplifying
assumption that all terms are smooth, and thus division and arbitrary
exponentiation are absent from the syntax. Several other standard logical
constructs are implemented as derived forms to reduce the soundness burden.
The types of formulas and programs are parameterized by three finite types
('a, 'b, 'c) used as identifiers for function constants, context constants, and
everything else, respectively. These type variables are distinct because some
substitution operations affect one type variable while leaving the others unchanged.
Because these types will be finite in practice, it is more useful to think of them
as natural numbers that happen to be represented as types (due to HOL's lack of dependent types).
The types of terms and ODE systems follow the same approach, but have only two type
variables because they cannot contain contexts.
›
datatype ('a, 'c) trm =
Var 'c
| Const real
| Function 'a "'c ⇒ ('a, 'c) trm" ("$f")
| Plus "('a, 'c) trm" "('a, 'c) trm"
| Times "('a, 'c) trm" "('a, 'c) trm"
| DiffVar 'c ("$''")
| Differential "('a, 'c) trm"
datatype('a, 'c) ODE =
OVar 'c
| OSing 'c "('a, 'c) trm"
| OProd "('a, 'c) ODE" "('a, 'c) ODE"
datatype ('a, 'b, 'c) hp =
Pvar 'c ("$α")
| Assign 'c "('a, 'c) trm" (infixr ":=" 10)
| DiffAssign 'c "('a, 'c) trm"
| Test "('a, 'b, 'c) formula" ("?")
| EvolveODE "('a, 'c) ODE" "('a, 'b, 'c) formula"
| Choice "('a, 'b, 'c) hp" "('a, 'b, 'c) hp" (infixl "∪∪" 10)
| Sequence "('a, 'b, 'c) hp" "('a, 'b, 'c) hp" (infixr ";;" 8)
| Loop "('a, 'b, 'c) hp" ("_**")
and ('a, 'b, 'c) formula =
Geq "('a, 'c) trm" "('a, 'c) trm"
| Prop 'c "'c ⇒ ('a, 'c) trm" ("$φ")
| Not "('a, 'b, 'c) formula" ("!")
| And "('a, 'b, 'c) formula" "('a, 'b, 'c) formula" (infixl "&&" 8)
| Exists 'c "('a, 'b, 'c) formula"
| Diamond "('a, 'b, 'c) hp" "('a, 'b, 'c) formula" ("(⟨ _ ⟩ _)" 10)
| InContext 'b "('a, 'b, 'c) formula"
definition Or :: "('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula" (infixl "||" 7)
where "Or P Q = Not (And (Not P) (Not Q))"
definition Implies :: "('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula" (infixr "→" 10)
where "Implies P Q = Or Q (Not P)"
definition Equiv :: "('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula" (infixl "↔" 10)
where "Equiv P Q = Or (And P Q) (And (Not P) (Not Q))"
definition Forall :: "'c ⇒ ('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula"
where "Forall x P = Not (Exists x (Not P))"
definition Equals :: "('a, 'c) trm ⇒ ('a, 'c) trm ⇒ ('a, 'b, 'c) formula"
where "Equals θ θ' = ((Geq θ θ') && (Geq θ' θ))"
definition Greater :: "('a, 'c) trm ⇒ ('a, 'c) trm ⇒ ('a, 'b, 'c) formula"
where "Greater θ θ' = ((Geq θ θ') && (Not (Geq θ' θ)))"
definition Box :: "('a, 'b, 'c) hp ⇒ ('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) formula" ("([[_]]_)" 10)
where "Box α P = Not (Diamond α (Not P))"
definition TT ::"('a,'b,'c) formula"
where "TT = Geq (Const 0) (Const 0)"
definition FF ::"('a,'b,'c) formula"
where "FF = Geq (Const 0) (Const 1)"
type_synonym ('a,'b,'c) sequent = "('a,'b,'c) formula list * ('a,'b,'c) formula list"
type_synonym ('a,'b,'c) rule = "('a,'b,'c) sequent list * ('a,'b,'c) sequent"
primrec sizeF::"('sf,'sc, 'sz) formula ⇒ nat"
and sizeP::"('sf,'sc, 'sz) hp ⇒ nat"
where
"sizeP (Pvar a) = 1"
| "sizeP (Assign x θ) = 1"
| "sizeP (DiffAssign x θ) = 1"
| "sizeP (Test φ) = Suc (sizeF φ)"
| "sizeP (EvolveODE ODE φ) = Suc (sizeF φ)"
| "sizeP (Choice α β) = Suc (sizeP α + sizeP β)"
| "sizeP (Sequence α β) = Suc (sizeP α + sizeP β)"
| "sizeP (Loop α) = Suc (sizeP α)"
| "sizeF (Geq p q) = 1"
| "sizeF (Prop p args) = 1"
| "sizeF (Not p) = Suc (sizeF p)"
| "sizeF (And p q) = sizeF p + sizeF q"
| "sizeF (Exists x p) = Suc (sizeF p)"
| "sizeF (Diamond p q) = Suc (sizeP p + sizeF q)"
| "sizeF (InContext C φ) = Suc (sizeF φ)"
lemma sizeF_diseq:"sizeF p ≠ sizeF q ⟹ p ≠ q" by auto
named_theorems "expr_diseq" "Structural disequality rules for expressions"
lemma [expr_diseq]:"p ≠ And p q" by(induction p, auto)
lemma [expr_diseq]:"q ≠ And p q" by(induction q, auto)
lemma [expr_diseq]:"p ≠ Not p" by(induction p, auto)
lemma [expr_diseq]:"p ≠ Or p q" by(rule sizeF_diseq, auto simp add: Or_def)
lemma [expr_diseq]:"q ≠ Or p q" by(rule sizeF_diseq, auto simp add: Or_def)
lemma [expr_diseq]:"p ≠ Implies p q" by(rule sizeF_diseq, auto simp add: Implies_def Or_def)
lemma [expr_diseq]:"q ≠ Implies p q" by(rule sizeF_diseq, auto simp add: Implies_def Or_def)
lemma [expr_diseq]:"p ≠ Equiv p q" by(rule sizeF_diseq, auto simp add: Equiv_def Or_def)
lemma [expr_diseq]:"q ≠ Equiv p q" by(rule sizeF_diseq, auto simp add: Equiv_def Or_def)
lemma [expr_diseq]:"p ≠ Exists x p" by(induction p, auto)
lemma [expr_diseq]:"p ≠ Diamond a p" by(induction p, auto)
lemma [expr_diseq]:"p ≠ InContext C p" by(induction p, auto)
fun Predicational :: "'b ⇒ ('a, 'b, 'c) formula" ("Pc")
where "Predicational P = InContext P (Geq (Const 0) (Const 0))"
context ids begin
definition empty::" 'b ⇒ ('a, 'b) trm"
where "empty ≡ λi.(Const 0)"
fun singleton :: "('a, 'sz) trm ⇒ ('sz ⇒ ('a, 'sz) trm)"
where "singleton t i = (if i = vid1 then t else (Const 0))"
lemma expand_singleton:"singleton t = (λi. (if i = vid1 then t else (Const 0)))"
by auto
definition f1::"'sf ⇒ 'sz ⇒ ('sf,'sz) trm"
where "f1 f x = Function f (singleton (Var x))"
definition f0::"'sf ⇒ ('sf,'sz) trm"
where "f0 f = Function f empty"
definition p1::"'sz ⇒ 'sz ⇒ ('sf, 'sc, 'sz) formula"
where "p1 p x = Prop p (singleton (Var x))"
definition P::"'sc ⇒ ('sf, 'sc, 'sz) formula"
where "P p = Predicational p"
end
subsection ‹Well-Formedness predicates›
inductive dfree :: "('a, 'c) trm ⇒ bool"
where
dfree_Var: "dfree (Var i)"
| dfree_Const: "dfree (Const r)"
| dfree_Fun: "(⋀i. dfree (args i)) ⟹ dfree (Function i args)"
| dfree_Plus: "dfree θ⇩1 ⟹ dfree θ⇩2 ⟹ dfree (Plus θ⇩1 θ⇩2)"
| dfree_Times: "dfree θ⇩1 ⟹ dfree θ⇩2 ⟹ dfree (Times θ⇩1 θ⇩2)"
inductive dsafe :: "('a, 'c) trm ⇒ bool"
where
dsafe_Var: "dsafe (Var i)"
| dsafe_Const: "dsafe (Const r)"
| dsafe_Fun: "(⋀i. dsafe (args i)) ⟹ dsafe (Function i args)"
| dsafe_Plus: "dsafe θ⇩1 ⟹ dsafe θ⇩2 ⟹ dsafe (Plus θ⇩1 θ⇩2)"
| dsafe_Times: "dsafe θ⇩1 ⟹ dsafe θ⇩2 ⟹ dsafe (Times θ⇩1 θ⇩2)"
| dsafe_Diff: "dfree θ ⟹ dsafe (Differential θ)"
| dsafe_DiffVar: "dsafe ($' i)"
fun ODE_dom::"('a, 'c) ODE ⇒ 'c set"
where
"ODE_dom (OVar c) = {}"
| "ODE_dom (OSing x θ) = {x}"
| "ODE_dom (OProd ODE1 ODE2) = ODE_dom ODE1 ∪ ODE_dom ODE2"
inductive osafe:: "('a, 'c) ODE ⇒ bool"
where
osafe_Var:"osafe (OVar c)"
| osafe_Sing:"dfree θ ⟹ osafe (OSing x θ)"
| osafe_Prod:"osafe ODE1 ⟹ osafe ODE2 ⟹ ODE_dom ODE1 ∩ ODE_dom ODE2 = {} ⟹ osafe (OProd ODE1 ODE2)"
inductive hpfree:: "('a, 'b, 'c) hp ⇒ bool"
and ffree:: "('a, 'b, 'c) formula ⇒ bool"
where
"hpfree (Pvar x)"
| "dfree e ⟹ hpfree (Assign x e)"
| "dfree e ⟹ hpfree (DiffAssign x e)"
| "ffree P ⟹ hpfree (Test P)"
| "osafe ODE ⟹ ffree P ⟹ hpfree (EvolveODE ODE P)"
| "hpfree a ⟹ hpfree b ⟹ hpfree (Choice a b )"
| "hpfree a ⟹ hpfree b ⟹ hpfree (Sequence a b)"
| "hpfree a ⟹ hpfree (Loop a)"
| "ffree f ⟹ ffree (InContext C f)"
| "(⋀arg. arg ∈ range args ⟹ dfree arg) ⟹ ffree (Prop p args)"
| "ffree p ⟹ ffree (Not p)"
| "ffree p ⟹ ffree q ⟹ ffree (And p q)"
| "ffree p ⟹ ffree (Exists x p)"
| "hpfree a ⟹ ffree p ⟹ ffree (Diamond a p)"
| "ffree (Predicational P)"
| "dfree t1 ⟹ dfree t2 ⟹ ffree (Geq t1 t2)"
inductive hpsafe:: "('a, 'b, 'c) hp ⇒ bool"
and fsafe:: "('a, 'b, 'c) formula ⇒ bool"
where
hpsafe_Pvar:"hpsafe (Pvar x)"
| hpsafe_Assign:"dsafe e ⟹ hpsafe (Assign x e)"
| hpsafe_DiffAssign:"dsafe e ⟹ hpsafe (DiffAssign x e)"
| hpsafe_Test:"fsafe P ⟹ hpsafe (Test P)"
| hpsafe_Evolve:"osafe ODE ⟹ fsafe P ⟹ hpsafe (EvolveODE ODE P)"
| hpsafe_Choice:"hpsafe a ⟹ hpsafe b ⟹ hpsafe (Choice a b )"
| hpsafe_Sequence:"hpsafe a ⟹ hpsafe b ⟹ hpsafe (Sequence a b)"
| hpsafe_Loop:"hpsafe a ⟹ hpsafe (Loop a)"
| fsafe_Geq:"dsafe t1 ⟹ dsafe t2 ⟹ fsafe (Geq t1 t2)"
| fsafe_Prop:"(⋀i. dsafe (args i)) ⟹ fsafe (Prop p args)"
| fsafe_Not:"fsafe p ⟹ fsafe (Not p)"
| fsafe_And:"fsafe p ⟹ fsafe q ⟹ fsafe (And p q)"
| fsafe_Exists:"fsafe p ⟹ fsafe (Exists x p)"
| fsafe_Diamond:"hpsafe a ⟹ fsafe p ⟹ fsafe (Diamond a p)"
| fsafe_InContext:"fsafe f ⟹ fsafe (InContext C f)"
inductive_simps
dfree_Plus_simps[simp]: "dfree (Plus a b)"
and dfree_Times_simps[simp]: "dfree (Times a b)"
and dfree_Var_simps[simp]: "dfree (Var x)"
and dfree_DiffVar_simps[simp]: "dfree (DiffVar x)"
and dfree_Differential_simps[simp]: "dfree (Differential x)"
and dfree_Fun_simps[simp]: "dfree (Function i args)"
and dfree_Const_simps[simp]: "dfree (Const r)"
inductive_simps
dsafe_Plus_simps[simp]: "dsafe (Plus a b)"
and dsafe_Times_simps[simp]: "dsafe (Times a b)"
and dsafe_Var_simps[simp]: "dsafe (Var x)"
and dsafe_DiffVar_simps[simp]: "dsafe (DiffVar x)"
and dsafe_Fun_simps[simp]: "dsafe (Function i args)"
and dsafe_Diff_simps[simp]: "dsafe (Differential a)"
and dsafe_Const_simps[simp]: "dsafe (Const r)"
inductive_simps
osafe_OVar_simps[simp]:"osafe (OVar c)"
and osafe_OSing_simps[simp]:"osafe (OSing x θ)"
and osafe_OProd_simps[simp]:"osafe (OProd ODE1 ODE2)"
inductive_simps
hpsafe_Pvar_simps[simp]: "hpsafe (Pvar a)"
and hpsafe_Sequence_simps[simp]: "hpsafe (a ;; b)"
and hpsafe_Loop_simps[simp]: "hpsafe (a**)"
and hpsafe_ODE_simps[simp]: "hpsafe (EvolveODE ODE p)"
and hpsafe_Choice_simps[simp]: "hpsafe (a ∪∪ b)"
and hpsafe_Assign_simps[simp]: "hpsafe (Assign x e)"
and hpsafe_DiffAssign_simps[simp]: "hpsafe (DiffAssign x e)"
and hpsafe_Test_simps[simp]: "hpsafe (? p)"
and fsafe_Geq_simps[simp]: "fsafe (Geq t1 t2)"
and fsafe_Prop_simps[simp]: "fsafe (Prop p args)"
and fsafe_Not_simps[simp]: "fsafe (Not p)"
and fsafe_And_simps[simp]: "fsafe (And p q)"
and fsafe_Exists_simps[simp]: "fsafe (Exists x p)"
and fsafe_Diamond_simps[simp]: "fsafe (Diamond a p)"
and fsafe_Context_simps[simp]: "fsafe (InContext C p)"
definition Ssafe::"('sf,'sc,'sz) sequent ⇒ bool"
where "Ssafe S ⟷((∀i. i ≥ 0 ⟶ i < length (fst S) ⟶ fsafe (nth (fst S) i))
∧(∀i. i ≥ 0 ⟶ i < length (snd S) ⟶ fsafe (nth (snd S) i)))"
definition Rsafe::"('sf,'sc,'sz) rule ⇒ bool"
where "Rsafe R ⟷ ((∀i. i ≥ 0 ⟶ i < length (fst R) ⟶ Ssafe (nth (fst R) i))
∧ Ssafe (snd R))"
lemma dfree_is_dsafe: "dfree θ ⟹ dsafe θ"
by (induction rule: dfree.induct) (auto intro: dsafe.intros)
lemma hp_induct [case_names Var Assign DiffAssign Test Evolve Choice Compose Star]:
"(⋀x. P ($α x)) ⟹
(⋀x1 x2. P (x1 := x2)) ⟹
(⋀x1 x2. P (DiffAssign x1 x2)) ⟹
(⋀x. P (? x)) ⟹
(⋀x1 x2. P (EvolveODE x1 x2)) ⟹
(⋀x1 x2. P x1 ⟹ P x2 ⟹ P (x1 ∪∪ x2)) ⟹
(⋀x1 x2. P x1 ⟹ P x2 ⟹ P (x1 ;; x2)) ⟹
(⋀x. P x ⟹ P x**) ⟹
P hp"
by(induction rule: hp.induct) (auto)
lemma fml_induct:
"(⋀t1 t2. P (Geq t1 t2))
⟹ (⋀p args. P (Prop p args))
⟹ (⋀p. P p ⟹ P (Not p))
⟹ (⋀p q. P p ⟹ P q ⟹ P (And p q))
⟹ (⋀x p. P p ⟹ P (Exists x p))
⟹ (⋀a p. P p ⟹ P (Diamond a p))
⟹ (⋀C p. P p ⟹ P (InContext C p))
⟹ P φ"
by (induction rule: formula.induct) (auto)
context ids begin
lemma proj_sing1:"(singleton θ vid1) = θ"
by (auto)
lemma proj_sing2:"vid1 ≠ y ⟹ (singleton θ y) = (Const 0)"
by (auto)
end
end
Theory Denotational_Semantics
theory "Denotational_Semantics"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Lib"
"Ids"
"Syntax"
begin
subsection ‹Denotational Semantics›
text ‹
The canonical dynamic semantics of dL are given as a denotational semantics.
The important definitions for the denotational semantics are states $\nu$,
interpretations I and the semantic functions $[[\psi]]I$, $[[\theta]]I\nu$,
$[[\alpha]]I$, which are represented by the Isabelle functions \verb|fml_sem|,
\verb|dterm_sem| and \verb|prog_sem|, respectively.
›
subsection ‹States›
text ‹We formalize a state S as a pair $(S_V, S_V') : R^n \times R^n $, where $S_V$ assigns
values to the program variables and $S_V$' assigns values to their
differentials. Function constants are also formalized as having a fixed arity
m \verb|(Rvec_dim)| which may differ from n. If a function does not need to
have m arguments, any remaining arguments can be uniformly set to 0,
which simulates the affect of having functions of less arguments.
Most semantic proofs need to reason about states agreeing on variables.
We say Vagree A B V if states A and B have the same values on all variables in V,
similarly with VSagree A B V for simple states A and B and Iagree I J V for interpretations
I and J.
›
type_synonym 'a Rvec = "real^('a::finite)"
type_synonym 'a state = "'a Rvec × 'a Rvec"
type_synonym 'a simple_state = "'a Rvec"
definition Vagree :: "'c::finite state ⇒ 'c state ⇒ ('c + 'c) set ⇒ bool"
where "Vagree ν ν' V ≡
(∀i. Inl i ∈ V ⟶ fst ν $ i = fst ν' $ i)
∧ (∀i. Inr i ∈ V ⟶ snd ν $ i = snd ν' $ i)"
definition VSagree :: "'c::finite simple_state ⇒ 'c simple_state ⇒ 'c set ⇒ bool"
where "VSagree ν ν' V ⟷ (∀i ∈ V. (ν $ i) = (ν' $ i))"
lemma agree_nil:"Vagree ν ω {}"
by (auto simp add: Vagree_def)
lemma agree_supset:"A ⊇ B ⟹ Vagree ν ν' A ⟹ Vagree ν ν' B"
by (auto simp add: Vagree_def)
lemma VSagree_nil:"VSagree ν ω {}"
by (auto simp add: VSagree_def)
lemma VSagree_supset:"A ⊇ B ⟹ VSagree ν ν' A ⟹ VSagree ν ν' B"
by (auto simp add: VSagree_def)
lemma VSagree_UNIV_eq:"VSagree A B UNIV ⟹ A = B"
unfolding VSagree_def by (auto simp add: vec_eq_iff)
lemma agree_comm:"⋀A B V. Vagree A B V ⟹ Vagree B A V" unfolding Vagree_def by auto
lemma agree_sub:"⋀ν ω A B . A ⊆ B ⟹ Vagree ν ω B ⟹ Vagree ν ω A"
unfolding Vagree_def by auto
lemma agree_UNIV_eq:"⋀ν ω. Vagree ν ω UNIV ⟹ ν = ω"
unfolding Vagree_def by (auto simp add: vec_eq_iff)
lemma agree_UNIV_fst:"⋀ν ω. Vagree ν ω (Inl ` UNIV) ⟹ (fst ν) = (fst ω)"
unfolding Vagree_def by (auto simp add: vec_eq_iff)
lemma agree_UNIV_snd:"⋀ν ω. Vagree ν ω (Inr ` UNIV) ⟹ (snd ν) = (snd ω)"
unfolding Vagree_def by (auto simp add: vec_eq_iff)
lemma Vagree_univ:"⋀a b c d. Vagree (a,b) (c,d) UNIV ⟹ a = c ∧ b = d"
by (auto simp add: Vagree_def vec_eq_iff)
lemma agree_union:"⋀ν ω A B. Vagree ν ω A ⟹ Vagree ν ω B ⟹ Vagree ν ω (A ∪ B)"
unfolding Vagree_def by (auto simp add: vec_eq_iff)
lemma agree_trans:"Vagree ν μ A ⟹ Vagree μ ω B ⟹ Vagree ν ω (A ∩ B)"
by (auto simp add: Vagree_def)
lemma agree_refl:"Vagree ν ν A"
by (auto simp add: Vagree_def)
lemma VSagree_sub:"⋀ν ω A B . A ⊆ B ⟹ VSagree ν ω B ⟹ VSagree ν ω A"
unfolding VSagree_def by auto
lemma VSagree_refl:"VSagree ν ν A"
by (auto simp add: VSagree_def)
subsection Interpretations
text‹
For convenience we pretend interpretations contain an extra field called
FunctionFrechet specifying the Frechet derivative \verb|(FunctionFrechet f ν)| : $R^m \rightarrow R$
for every function in every state. The proposition \verb|(is_interp I)| says that such a
derivative actually exists and is continuous (i.e. all functions are C1-continuous)
without saying what the exact derivative is.
The type parameters 'a, 'b, 'c are finite types whose cardinalities indicate the maximum number
of functions, contexts, and <everything else defined by the interpretation>, respectively.
›
record ('a, 'b, 'c) interp =
Functions :: "'a ⇒ 'c Rvec ⇒ real"
Predicates :: "'c ⇒ 'c Rvec ⇒ bool"
Contexts :: "'b ⇒ 'c state set ⇒ 'c state set"
Programs :: "'c ⇒ ('c state * 'c state) set"
ODEs :: "'c ⇒ 'c simple_state ⇒ 'c simple_state"
ODEBV :: "'c ⇒ 'c set"
fun FunctionFrechet :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ 'a ⇒ 'c Rvec ⇒ 'c Rvec ⇒ real"
where "FunctionFrechet I i = (THE f'. ∀ x. (Functions I i has_derivative f' x) (at x))"
definition is_interp :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ bool"
where "is_interp I ≡
∀x. ∀i. ((FDERIV (Functions I i) x :> (FunctionFrechet I i x)) ∧ continuous_on UNIV (λx. Blinfun (FunctionFrechet I i x)))"
lemma is_interpD:"is_interp I ⟹ ∀x. ∀i. (FDERIV (Functions I i) x :> (FunctionFrechet I i x))"
unfolding is_interp_def by auto
definition Iagree :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a + 'b + 'c) set ⇒ bool"
where "Iagree I J V ≡
(∀i∈V.
(∀x. i = Inl x ⟶ Functions I x = Functions J x) ∧
(∀x. i = Inr (Inl x) ⟶ Contexts I x = Contexts J x) ∧
(∀x. i = Inr (Inr x) ⟶ Predicates I x = Predicates J x) ∧
(∀x. i = Inr (Inr x) ⟶ Programs I x = Programs J x) ∧
(∀x. i = Inr (Inr x) ⟶ ODEs I x = ODEs J x) ∧
(∀x. i = Inr (Inr x) ⟶ ODEBV I x = ODEBV J x))"
lemma Iagree_Func:"Iagree I J V ⟹ Inl f ∈ V ⟹ Functions I f = Functions J f"
unfolding Iagree_def by auto
lemma Iagree_Contexts:"Iagree I J V ⟹ Inr (Inl C) ∈ V ⟹ Contexts I C = Contexts J C"
unfolding Iagree_def by auto
lemma Iagree_Pred:"Iagree I J V ⟹ Inr (Inr p) ∈ V ⟹ Predicates I p = Predicates J p"
unfolding Iagree_def by auto
lemma Iagree_Prog:"Iagree I J V ⟹ Inr (Inr a) ∈ V ⟹ Programs I a = Programs J a"
unfolding Iagree_def by auto
lemma Iagree_ODE:"Iagree I J V ⟹ Inr (Inr a) ∈ V ⟹ ODEs I a = ODEs J a"
unfolding Iagree_def by auto
lemma Iagree_comm:"⋀A B V. Iagree A B V ⟹ Iagree B A V"
unfolding Iagree_def by auto
lemma Iagree_sub:"⋀I J A B . A ⊆ B ⟹ Iagree I J B ⟹ Iagree I J A"
unfolding Iagree_def by auto
lemma Iagree_refl:"Iagree I I A"
by (auto simp add: Iagree_def)
primrec sterm_sem :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a, 'c) trm ⇒ 'c simple_state ⇒ real"
where
"sterm_sem I (Var x) v = v $ x"
| "sterm_sem I (Function f args) v = Functions I f (χ i. sterm_sem I (args i) v)"
| "sterm_sem I (Plus t1 t2) v = sterm_sem I t1 v + sterm_sem I t2 v"
| "sterm_sem I (Times t1 t2) v = sterm_sem I t1 v * sterm_sem I t2 v"
| "sterm_sem I (Const r) v = r"
| "sterm_sem I ($' c) v = undefined"
| "sterm_sem I (Differential d) v = undefined"
primrec frechet :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a, 'c) trm ⇒ 'c simple_state ⇒ 'c simple_state ⇒ real"
where
"frechet I (Var x) v = (λv'. v' ∙ axis x 1)"
| "frechet I (Function f args) v =
(λv'. FunctionFrechet I f (χ i. sterm_sem I (args i) v) (χ i. frechet I (args i) v v'))"
| "frechet I (Plus t1 t2) v = (λv'. frechet I t1 v v' + frechet I t2 v v')"
| "frechet I (Times t1 t2) v =
(λv'. sterm_sem I t1 v * frechet I t2 v v' + frechet I t1 v v' * sterm_sem I t2 v)"
| "frechet I (Const r) v = (λv'. 0)"
| "frechet I ($' c) v = undefined"
| "frechet I (Differential d) v = undefined"
definition directional_derivative :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a, 'c) trm ⇒ 'c state ⇒ real"
where "directional_derivative I t = (λv. frechet I t (fst v) (snd v))"
primrec dterm_sem :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a, 'c) trm ⇒ 'c state ⇒ real"
where
"dterm_sem I (Var x) = (λv. fst v $ x)"
| "dterm_sem I (DiffVar x) = (λv. snd v $ x)"
| "dterm_sem I (Function f args) = (λv. Functions I f (χ i. dterm_sem I (args i) v))"
| "dterm_sem I (Plus t1 t2) = (λv. (dterm_sem I t1 v) + (dterm_sem I t2 v))"
| "dterm_sem I (Times t1 t2) = (λv. (dterm_sem I t1 v) * (dterm_sem I t2 v))"
| "dterm_sem I (Differential t) = (λv. directional_derivative I t v)"
| "dterm_sem I (Const c) = (λv. c)"
text‹ The semantics of an ODE is the vector field at a given point. ODE's are all time-independent
so no time variable is necessary. Terms on the RHS of an ODE must be differential-free, so
depends only on the xs.
The safety predicate \texttt{osafe} ensures the domains of ODE1 and ODE2 are disjoint, so vector addition
is equivalent to saying "take things defined from ODE1 from ODE1, take things defined
by ODE2 from ODE2"›
fun ODE_sem:: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a, 'c) ODE ⇒ 'c Rvec ⇒ 'c Rvec"
where
ODE_sem_OVar:"ODE_sem I (OVar x) = ODEs I x"
| ODE_sem_OSing:"ODE_sem I (OSing x θ) = (λν. (χ i. if i = x then sterm_sem I θ ν else 0))"
| ODE_sem_OProd:"ODE_sem I (OProd ODE1 ODE2) = (λν. ODE_sem I ODE1 ν + ODE_sem I ODE2 ν)"
fun ODE_vars :: "('a,'b,'c) interp ⇒ ('a, 'c) ODE ⇒ 'c set"
where
"ODE_vars I (OVar c) = ODEBV I c"
| "ODE_vars I (OSing x θ) = {x}"
| "ODE_vars I (OProd ODE1 ODE2) = ODE_vars I ODE1 ∪ ODE_vars I ODE2"
fun semBV ::"('a, 'b,'c) interp ⇒ ('a, 'c) ODE ⇒ ('c + 'c) set"
where "semBV I ODE = Inl ` (ODE_vars I ODE) ∪ Inr ` (ODE_vars I ODE)"
lemma ODE_vars_lr:
fixes x::"'sz" and ODE::"('sf,'sz) ODE" and I::"('sf,'sc,'sz) interp"
shows "Inl x ∈ semBV I ODE ⟷ Inr x ∈ semBV I ODE"
by (induction "ODE", auto)
fun mk_xode::"('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'c::finite) ODE ⇒ 'c::finite simple_state ⇒ 'c::finite state"
where "mk_xode I ODE sol = (sol, ODE_sem I ODE sol)"
text‹ Given an initial state $\nu$ and solution to an ODE at some point, construct the resulting state $\omega$.
This is defined using the SOME operator because the concrete definition is unwieldy. ›
definition mk_v::"('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'c::finite) ODE ⇒ 'c::finite state ⇒ 'c::finite simple_state ⇒ 'c::finite state"
where "mk_v I ODE ν sol = (THE ω.
Vagree ω ν (- semBV I ODE)
∧ Vagree ω (mk_xode I ODE sol) (semBV I ODE))"
fun repv :: "'c::finite state ⇒ 'c ⇒ real ⇒ 'c state"
where "repv v x r = ((χ y. if x = y then r else vec_nth (fst v) y), snd v)"
fun repd :: "'c::finite state ⇒ 'c ⇒ real ⇒ 'c state"
where "repd v x r = (fst v, (χ y. if x = y then r else vec_nth (snd v) y))"
fun fml_sem :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'b::finite, 'c::finite) formula ⇒ 'c::finite state set" and
prog_sem :: "('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'b::finite, 'c::finite) hp ⇒ ('c::finite state * 'c::finite state) set"
where
"fml_sem I (Geq t1 t2) = {v. dterm_sem I t1 v ≥ dterm_sem I t2 v}"
| "fml_sem I (Prop P terms) = {ν. Predicates I P (χ i. dterm_sem I (terms i) ν)}"
| "fml_sem I (Not φ) = {v. v ∉ fml_sem I φ}"
| "fml_sem I (And φ ψ) = fml_sem I φ ∩ fml_sem I ψ"
| "fml_sem I (Exists x φ) = {v | v r. (repv v x r) ∈ fml_sem I φ}"
| "fml_sem I (Diamond α φ) = {ν | ν ω. (ν, ω) ∈ prog_sem I α ∧ ω ∈ fml_sem I φ}"
| "fml_sem I (InContext c φ) = Contexts I c (fml_sem I φ)"
| "prog_sem I (Pvar p) = Programs I p"
| "prog_sem I (Assign x t) = {(ν, ω). ω = repv ν x (dterm_sem I t ν)}"
| "prog_sem I (DiffAssign x t) = {(ν, ω). ω = repd ν x (dterm_sem I t ν)}"
| "prog_sem I (Test φ) = {(ν, ν) | ν. ν ∈ fml_sem I φ}"
| "prog_sem I (Choice α β) = prog_sem I α ∪ prog_sem I β"
| "prog_sem I (Sequence α β) = prog_sem I α O prog_sem I β"
| "prog_sem I (Loop α) = (prog_sem I α)⇧*"
| "prog_sem I (EvolveODE ODE φ) =
({(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
sol 0 = fst ν})"
context ids begin
definition valid :: "('sf, 'sc, 'sz) formula ⇒ bool"
where "valid φ ≡ (∀ I. ∀ ν. is_interp I ⟶ ν ∈ fml_sem I φ)"
end
text‹ Because mk\_v is defined with the SOME operator, need to construct a state that satisfies
${\tt Vagree} \omega \nu (- {\tt ODE\_vars\ ODE})
\wedge {\tt Vagree} \omega {\tt (mk\_xode\ I\ ODE\ sol)\ (ODE\_vars\ ODE)})$
to do anything useful ›
fun concrete_v::"('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'c::finite) ODE ⇒ 'c::finite state ⇒ 'c::finite simple_state ⇒ 'c::finite state"
where "concrete_v I ODE ν sol =
((χ i. (if Inl i ∈ semBV I ODE then sol else (fst ν)) $ i),
(χ i. (if Inr i ∈ semBV I ODE then ODE_sem I ODE sol else (snd ν)) $ i))"
lemma mk_v_exists:"∃ω. Vagree ω ν (- semBV I ODE)
∧ Vagree ω (mk_xode I ODE sol) (semBV I ODE)"
by(rule exI[where x="(concrete_v I ODE ν sol)"], auto simp add: Vagree_def)
lemma mk_v_agree:"Vagree (mk_v I ODE ν sol) ν (- semBV I ODE)
∧ Vagree (mk_v I ODE ν sol) (mk_xode I ODE sol) (semBV I ODE)"
unfolding mk_v_def
apply(rule theI[where a= "((χ i. (if Inl i ∈ semBV I ODE then sol else (fst ν)) $ i),
(χ i. (if Inr i ∈ semBV I ODE then ODE_sem I ODE sol else (snd ν)) $ i))"])
using exE[OF mk_v_exists, of ν I ODE sol]
by (auto simp add: Vagree_def vec_eq_iff)
lemma mk_v_concrete:"mk_v I ODE ν sol = ((χ i. (if Inl i ∈ semBV I ODE then sol else (fst ν)) $ i),
(χ i. (if Inr i ∈ semBV I ODE then ODE_sem I ODE sol else (snd ν)) $ i))"
apply(rule agree_UNIV_eq)
using mk_v_agree[of I ODE ν sol]
unfolding Vagree_def by auto
subsection ‹Trivial Simplification Lemmas›
text ‹
We often want to pretend the definitions in the semantics are written slightly
differently than they are. Since the simplifier has some trouble guessing that
these are the right simplifications to do, we write them all out explicitly as
lemmas, even though they prove trivially.
›
lemma svar_case:
"sterm_sem I (Var x) = (λv. v $ x)"
by auto
lemma sconst_case:
"sterm_sem I (Const r) = (λv. r)"
by auto
lemma sfunction_case:
"sterm_sem I (Function f args) = (λv. Functions I f (χ i. sterm_sem I (args i) v))"
by auto
lemma splus_case:
"sterm_sem I (Plus t1 t2) = (λv. (sterm_sem I t1 v) + (sterm_sem I t2 v))"
by auto
lemma stimes_case:
"sterm_sem I (Times t1 t2) = (λv. (sterm_sem I t1 v) * (sterm_sem I t2 v))"
by auto
lemma or_sem [simp]:
"fml_sem I (Or φ ψ) = fml_sem I φ ∪ fml_sem I ψ"
by (auto simp add: Or_def)
lemma iff_sem [simp]: "(ν ∈ fml_sem I (A ↔ B))
⟷ ((ν ∈ fml_sem I A) ⟷ (ν ∈ fml_sem I B))"
by (auto simp add: Equiv_def)
lemma box_sem [simp]:"fml_sem I (Box α φ) = {ν. ∀ ω. (ν, ω) ∈ prog_sem I α ⟶ ω ∈ fml_sem I φ}"
unfolding Box_def fml_sem.simps
using Collect_cong by (auto)
lemma forall_sem [simp]:"fml_sem I (Forall x φ) = {v. ∀r. (repv v x r) ∈ fml_sem I φ}"
unfolding Forall_def fml_sem.simps
using Collect_cong by (auto)
lemma greater_sem[simp]:"fml_sem I (Greater θ θ') = {v. dterm_sem I θ v > dterm_sem I θ' v}"
unfolding Greater_def by auto
lemma loop_sem:"prog_sem I (Loop α) = (prog_sem I α)⇧*"
by (auto)
lemma impl_sem [simp]: "(ν ∈ fml_sem I (A → B))
= ((ν ∈ fml_sem I A) ⟶ (ν ∈ fml_sem I B))"
by (auto simp add: Implies_def)
lemma equals_sem [simp]: "(ν ∈ fml_sem I (Equals θ θ'))
= (dterm_sem I θ ν = dterm_sem I θ' ν)"
by (auto simp add: Equals_def)
lemma diamond_sem [simp]: "fml_sem I (Diamond α φ)
= {ν. ∃ ω. (ν, ω) ∈ prog_sem I α ∧ ω ∈ fml_sem I φ}"
by auto
lemma tt_sem [simp]:"fml_sem I TT = UNIV" unfolding TT_def by auto
lemma ff_sem [simp]:"fml_sem I FF = {}" unfolding FF_def by auto
lemma iff_to_impl: "((ν ∈ fml_sem I A) ⟷ (ν ∈ fml_sem I B))
⟷ (((ν ∈ fml_sem I A) ⟶ (ν ∈ fml_sem I B))
∧ ((ν ∈ fml_sem I B) ⟶ (ν ∈ fml_sem I A)))"
by (auto)
fun seq2fml :: "('a,'b,'c) sequent ⇒ ('a,'b,'c) formula"
where
"seq2fml (ante,succ) = Implies (foldr And ante TT) (foldr Or succ FF)"
context ids begin
fun seq_sem ::"('sf, 'sc, 'sz) interp ⇒ ('sf, 'sc, 'sz) sequent ⇒ 'sz state set"
where "seq_sem I S = fml_sem I (seq2fml S)"
lemma and_foldl_sem:"ν ∈ fml_sem I (foldr And Γ TT) ⟹ (⋀φ. List.member Γ φ ⟹ ν ∈ fml_sem I φ)"
by(induction Γ, auto simp add: member_rec)
lemma and_foldl_sem_conv:"(⋀φ. List.member Γ φ ⟹ ν ∈ fml_sem I φ) ⟹ ν ∈ fml_sem I (foldr And Γ TT)"
by(induction Γ, auto simp add: member_rec)
lemma or_foldl_sem:"List.member Γ φ ⟹ ν ∈ fml_sem I φ ⟹ ν ∈ fml_sem I (foldr Or Γ FF)"
by(induction Γ, auto simp add: member_rec)
lemma or_foldl_sem_conv:"ν ∈ fml_sem I (foldr Or Γ FF) ⟹ ∃ φ. ν ∈ fml_sem I φ ∧ List.member Γ φ"
by(induction Γ, auto simp add: member_rec)
lemma seq_semI':"(ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I (foldr Or Δ FF)) ⟹ ν ∈ seq_sem I (Γ,Δ)"
by auto
lemma seq_semD':"⋀P. ν ∈ seq_sem I (Γ,Δ) ⟹ ((ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I (foldr Or Δ FF)) ⟹ P) ⟹ P"
by simp
definition sublist::"'a list ⇒ 'a list ⇒ bool"
where "sublist A B ≡ (∀x. List.member A x ⟶ List.member B x)"
lemma sublistI:"(⋀x. List.member A x ⟹ List.member B x) ⟹ sublist A B"
unfolding sublist_def by auto
lemma Γ_sub_sem:"sublist Γ1 Γ2 ⟹ ν ∈ fml_sem I (foldr And Γ2 TT) ⟹ ν ∈ fml_sem I (foldr And Γ1 TT)"
unfolding sublist_def
by (metis and_foldl_sem and_foldl_sem_conv)
lemma seq_semI:"List.member Δ ψ ⟹((⋀φ. List.member Γ φ ⟹ ν ∈ fml_sem I φ) ⟹ ν ∈ fml_sem I ψ) ⟹ ν ∈ seq_sem I (Γ,Δ)"
apply(rule seq_semI')
using and_foldl_sem[of ν I Γ] or_foldl_sem by blast
lemma seq_semD:"ν ∈ seq_sem I (Γ,Δ) ⟹ (⋀φ. List.member Γ φ ⟹ ν ∈ fml_sem I φ) ⟹ ∃φ. (List.member Δ φ) ∧ν ∈ fml_sem I φ "
apply(rule seq_semD')
using and_foldl_sem_conv or_foldl_sem_conv
by blast+
lemma seq_MP:"ν ∈ seq_sem I (Γ,Δ) ⟹ ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I (foldr Or Δ FF)"
by(induction Δ, auto)
definition seq_valid
where "seq_valid S ≡ ∀I. is_interp I ⟶ seq_sem I S = UNIV"
text‹ Soundness for derived rules is local soundness, i.e. if the premisses are all true in the same interpretation,
then the conclusion is also true in that same interpretation. ›
definition sound :: "('sf, 'sc, 'sz) rule ⇒ bool"
where "sound R ⟷ (∀I. is_interp I ⟶ (∀i. i ≥ 0 ⟶ i < length (fst R) ⟶ seq_sem I (nth (fst R) i) = UNIV) ⟶ seq_sem I (snd R) = UNIV)"
lemma soundI:"(⋀I. is_interp I ⟹ (⋀i. i ≥ 0 ⟹ i < length SG ⟹ seq_sem I (nth SG i) = UNIV) ⟹ seq_sem I G = UNIV) ⟹ sound (SG,G)"
unfolding sound_def by auto
lemma soundI':"(⋀I ν. is_interp I ⟹ (⋀i . i ≥ 0 ⟹ i < length SG ⟹ ν ∈ seq_sem I (nth SG i)) ⟹ ν ∈ seq_sem I G) ⟹ sound (SG,G)"
unfolding sound_def by auto
lemma soundI_mem:"(⋀I. is_interp I ⟹ (⋀φ. List.member SG φ ⟹ seq_sem I φ = UNIV) ⟹ seq_sem I C = UNIV) ⟹ sound (SG,C)"
apply (auto simp add: sound_def)
by (metis in_set_conv_nth in_set_member iso_tuple_UNIV_I seq2fml.simps)
lemma soundI_memv:"(⋀I. is_interp I ⟹ (⋀φ ν. List.member SG φ ⟹ ν ∈ seq_sem I φ) ⟹ (⋀ν. ν ∈ seq_sem I C)) ⟹ sound (SG,C)"
apply(rule soundI_mem)
using impl_sem by blast
lemma soundI_memv':"(⋀I. is_interp I ⟹ (⋀φ ν. List.member SG φ ⟹ ν ∈ seq_sem I φ) ⟹ (⋀ν. ν ∈ seq_sem I C)) ⟹ R = (SG,C) ⟹ sound R"
using soundI_mem
using impl_sem by blast
lemma soundD_mem:"sound (SG,C) ⟹ (⋀I. is_interp I ⟹ (⋀φ. List.member SG φ ⟹ seq_sem I φ = UNIV) ⟹ seq_sem I C = UNIV)"
apply (auto simp add: sound_def)
using in_set_conv_nth in_set_member iso_tuple_UNIV_I seq2fml.simps
by (metis seq2fml.elims)
lemma soundD_memv:"sound (SG,C) ⟹ (⋀I. is_interp I ⟹ (⋀φ ν. List.member SG φ ⟹ ν ∈ seq_sem I φ) ⟹ (⋀ν. ν ∈ seq_sem I C))"
using soundD_mem
by (metis UNIV_I UNIV_eq_I)
end
end
Theory Axioms
theory "Axioms"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
begin context ids begin
section ‹Axioms›
text ‹
The uniform substitution calculus is based on a finite list of concrete
axioms, which are defined and proved valid (as in sound) in this section. When axioms apply
to arbitrary programs or formulas, they mention concrete program or formula
variables, which are then instantiated by uniform substitution, as opposed
metavariables.
This section contains axioms and rules for propositional connectives and programs other than
ODE's. Differential axioms are handled separately because the proofs are significantly more involved.
›
named_theorems axiom_defs "Axiom definitions"
definition assign_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"assign_axiom ≡
([[vid1 := ($f fid1 empty)]] (Prop vid1 (singleton (Var vid1))))
↔ Prop vid1 (singleton ($f fid1 empty))"
definition diff_assign_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_assign_axiom ≡
([[DiffAssign vid1 ($f fid1 empty)]] (Prop vid1 (singleton (DiffVar vid1))))
↔ Prop vid1 (singleton ($f fid1 empty))"
definition loop_iterate_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"loop_iterate_axiom ≡ ([[$α vid1**]]Predicational pid1)
↔ ((Predicational pid1) && ([[$α vid1]][[$α vid1**]]Predicational pid1))"
definition test_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"test_axiom ≡
([[?($φ vid2 empty)]]$φ vid1 empty) ↔ (($φ vid2 empty) → ($φ vid1 empty))"
definition box_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"box_axiom ≡ (⟨$α vid1⟩Predicational pid1) ↔ !([[$α vid1]]!(Predicational pid1))"
definition choice_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"choice_axiom ≡ ([[$α vid1 ∪∪ $α vid2]]Predicational pid1)
↔ (([[$α vid1]]Predicational pid1) && ([[$α vid2]]Predicational pid1))"
definition compose_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"compose_axiom ≡ ([[$α vid1 ;; $α vid2]]Predicational pid1) ↔
([[$α vid1]][[ $α vid2]]Predicational pid1)"
definition Kaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"Kaxiom ≡ ([[$α vid1]]((Predicational pid1) → (Predicational pid2)))
→ ([[$α vid1]]Predicational pid1) → ([[$α vid1]]Predicational pid2)"
definition Iaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"Iaxiom ≡
([[($α vid1)**]](Predicational pid1 → ([[$α vid1]]Predicational pid1)))
→((Predicational pid1 → ([[($α vid1)**]]Predicational pid1)))"
definition Vaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"Vaxiom ≡ ($φ vid1 empty) → ([[$α vid1]]($φ vid1 empty))"
subsection ‹Validity proofs for axioms›
text ‹Because an axiom in a uniform substitution calculus is an individual formula,
proving the validity of that formula suffices to prove soundness›
theorem test_valid: "valid test_axiom"
by (auto simp add: valid_def test_axiom_def)
lemma assign_lem1:
"dterm_sem I (if i = vid1 then Var vid1 else (Const 0))
(vec_lambda (λy. if vid1 = y then Functions I fid1
(vec_lambda (λi. dterm_sem I (empty i) ν)) else vec_nth (fst ν) y), snd ν)
=
dterm_sem I (if i = vid1 then $f fid1 empty else (Const 0)) ν"
by (cases "i = vid1") (auto simp: proj_sing1)
lemma diff_assign_lem1:
"dterm_sem I (if i = vid1 then DiffVar vid1 else (Const 0))
(fst ν, vec_lambda (λy. if vid1 = y then Functions I fid1 (vec_lambda (λi. dterm_sem I (empty i) ν)) else vec_nth (snd ν) y))
=
dterm_sem I (if i = vid1 then $f fid1 empty else (Const 0)) ν
"
by (cases "i = vid1") (auto simp: proj_sing1)
theorem assign_valid: "valid assign_axiom"
unfolding valid_def assign_axiom_def
by (simp add: assign_lem1)
theorem diff_assign_valid: "valid diff_assign_axiom"
unfolding valid_def diff_assign_axiom_def
by (simp add: diff_assign_lem1)
lemma mem_to_nonempty: "ω ∈ S ⟹ (S ≠ {})"
by (auto)
lemma loop_forward: "ν ∈ fml_sem I ([[$α id1**]]Predicational pid1)
⟶ ν ∈ fml_sem I (Predicational pid1&&[[$α id1]][[$α id1**]]Predicational pid1)"
by (cases ν) (auto intro: converse_rtrancl_into_rtrancl simp add: box_sem)
lemma loop_backward:
"ν ∈ fml_sem I (Predicational pid1 && [[$α id1]][[$α id1**]]Predicational pid1)
⟶ ν ∈ fml_sem I ([[$α id1**]]Predicational pid1)"
by (auto elim: converse_rtranclE simp add: box_sem)
theorem loop_valid: "valid loop_iterate_axiom"
apply(simp only: valid_def loop_iterate_axiom_def)
apply(simp only: iff_sem)
apply(simp only: HOL.iff_conv_conj_imp)
apply(rule allI | rule impI)+
apply(rule conjI)
apply(rule loop_forward)
apply(rule loop_backward)
done
theorem box_valid: "valid box_axiom"
unfolding valid_def box_axiom_def by(auto)
theorem choice_valid: "valid choice_axiom"
unfolding valid_def choice_axiom_def by (auto)
theorem compose_valid: "valid compose_axiom"
unfolding valid_def compose_axiom_def by (auto)
theorem K_valid: "valid Kaxiom"
unfolding valid_def Kaxiom_def by (auto)
lemma I_axiom_lemma:
fixes I::"('sf,'sc,'sz) interp" and ν
assumes "is_interp I"
assumes IS:"ν ∈ fml_sem I ([[$α vid1**]](Predicational pid1 →
[[$α vid1]]Predicational pid1))"
assumes BC:"ν ∈ fml_sem I (Predicational pid1)"
shows "ν ∈ fml_sem I ([[$α vid1**]](Predicational pid1))"
proof -
have IS':"⋀ν2. (ν, ν2) ∈ (prog_sem I ($α vid1))⇧* ⟹ ν2 ∈ fml_sem I (Predicational pid1 → [[$α vid1]](Predicational pid1))"
using IS by (auto simp add: box_sem)
have res:"⋀ν3. ((ν, ν3) ∈ (prog_sem I ($α vid1))⇧*) ⟹ ν3 ∈ fml_sem I (Predicational pid1)"
proof -
fix ν3
show "((ν, ν3) ∈ (prog_sem I ($α vid1))⇧*) ⟹ ν3 ∈ fml_sem I (Predicational pid1)"
apply(induction rule:rtrancl_induct)
apply(rule BC)
proof -
fix y z
assume vy:"(ν, y) ∈ (prog_sem I ($α vid1))⇧*"
assume yz:"(y, z) ∈ prog_sem I ($α vid1)"
assume yPP:"y ∈ fml_sem I (Predicational pid1)"
have imp3:"y ∈ fml_sem I (Predicational pid1 → [[$α vid1 ]](Predicational pid1))"
using IS' vy by (simp)
have imp4:"y ∈ fml_sem I (Predicational pid1) ⟹ y ∈ fml_sem I ([[$α vid1]](Predicational pid1))"
using imp3 impl_sem by (auto)
have yaPP:"y ∈ fml_sem I ([[$α vid1]]Predicational pid1)" using imp4 yPP by auto
have zPP:"z ∈ fml_sem I (Predicational pid1)" using yaPP box_sem yz mem_Collect_eq by blast
show "
(ν, y) ∈ (prog_sem I ($α vid1))⇧* ⟹
(y, z) ∈ prog_sem I ($α vid1) ⟹
y ∈ fml_sem I (Predicational pid1) ⟹
z ∈ fml_sem I (Predicational pid1)" using zPP by simp
qed
qed
show "ν ∈ fml_sem I ([[$α vid1**]]Predicational pid1)"
using res by (simp add: mem_Collect_eq box_sem loop_sem)
qed
theorem I_valid: "valid Iaxiom"
apply(unfold Iaxiom_def valid_def)
apply(rule impI | rule allI)+
apply(simp only: impl_sem)
using I_axiom_lemma by blast
theorem V_valid: "valid Vaxiom"
apply(simp only: valid_def Vaxiom_def impl_sem box_sem)
apply(rule allI | rule impI)+
apply(auto simp add: empty_def)
done
definition G_holds :: "('sf, 'sc, 'sz) formula ⇒ ('sf, 'sc, 'sz) hp ⇒ bool"
where "G_holds φ α ≡ valid φ ⟶ valid ([[α]]φ)"
definition Skolem_holds :: "('sf, 'sc, 'sz) formula ⇒ 'sz ⇒ bool"
where "Skolem_holds φ var ≡ valid φ ⟶ valid (Forall var φ)"
definition MP_holds :: "('sf, 'sc, 'sz) formula ⇒ ('sf, 'sc, 'sz) formula ⇒ bool"
where "MP_holds φ ψ ≡ valid (φ → ψ) ⟶ valid φ ⟶ valid ψ"
definition CT_holds :: "'sf ⇒ ('sf, 'sz) trm ⇒ ('sf, 'sz) trm ⇒ bool"
where "CT_holds g θ θ' ≡ valid (Equals θ θ')
⟶ valid (Equals (Function g (singleton θ)) (Function g (singleton θ')))"
definition CQ_holds :: "'sz ⇒ ('sf, 'sz) trm ⇒ ('sf, 'sz) trm ⇒ bool"
where "CQ_holds p θ θ' ≡ valid (Equals θ θ')
⟶ valid ((Prop p (singleton θ)) ↔ (Prop p (singleton θ')))"
definition CE_holds :: "'sc ⇒ ('sf, 'sc, 'sz) formula ⇒ ('sf, 'sc, 'sz) formula ⇒ bool"
where "CE_holds var φ ψ ≡ valid (φ ↔ ψ)
⟶ valid (InContext var φ ↔ InContext var ψ)"
subsection ‹Soundness proofs for rules›
theorem G_sound: "G_holds φ α"
by (simp add: G_holds_def valid_def box_sem)
theorem Skolem_sound: "Skolem_holds φ var"
by (simp add: Skolem_holds_def valid_def)
theorem MP_sound: "MP_holds φ ψ"
by (auto simp add: MP_holds_def valid_def)
lemma CT_lemma:"⋀I::('sf::finite, 'sc::finite, 'sz::{finite,linorder}) interp. ⋀ a::(real, 'sz) vec. ⋀ b::(real, 'sz) vec. ∀I::('sf,'sc,'sz) interp. is_interp I ⟶ (∀a b. dterm_sem I θ (a, b) = dterm_sem I θ' (a, b)) ⟹
is_interp I ⟹
Functions I var (vec_lambda (λi. dterm_sem I (if i = vid1 then θ else (Const 0)) (a, b))) =
Functions I var (vec_lambda (λi. dterm_sem I (if i = vid1 then θ' else (Const 0)) (a, b)))"
proof -
fix I :: "('sf::finite, 'sc::finite, 'sz::{finite,linorder}) interp" and a :: "(real, 'sz) vec" and b :: "(real, 'sz) vec"
assume a1: "is_interp I"
assume "∀I::('sf,'sc,'sz) interp. is_interp I ⟶ (∀a b. dterm_sem I θ (a, b) = dterm_sem I θ' (a, b))"
then have "∀i. dterm_sem I (if i = vid1 then θ' else (Const 0)) (a, b) = dterm_sem I (if i = vid1 then θ else (Const 0)) (a, b)"
using a1 by presburger
then show "Functions I var (vec_lambda (λi. dterm_sem I (if i = vid1 then θ else (Const 0)) (a, b)))
= Functions I var (vec_lambda (λi. dterm_sem I (if i = vid1 then θ' else (Const 0)) (a, b)))"
by presburger
qed
theorem CT_sound: "CT_holds var θ θ'"
apply(simp only: CT_holds_def valid_def equals_sem vec_extensionality vec_eq_iff)
apply(simp)
apply(rule allI | rule impI)+
apply(simp add: CT_lemma)
done
theorem CQ_sound: "CQ_holds var θ θ'"
proof (auto simp only: CQ_holds_def valid_def equals_sem vec_extensionality vec_eq_iff singleton.simps mem_Collect_eq)
fix I :: "('sf,'sc,'sz) interp" and a b
assume sem:"∀I::('sf,'sc,'sz) interp. ∀ ν. is_interp I ⟶ dterm_sem I θ ν = dterm_sem I θ' ν"
assume good:"is_interp I"
have sem_eq:"dterm_sem I θ (a,b) = dterm_sem I θ' (a,b)"
using sem good by auto
have feq:"(χ i. dterm_sem I (if i = vid1 then θ else Const 0) (a, b)) = (χ i. dterm_sem I (if i = vid1 then θ' else Const 0) (a, b))"
apply(rule vec_extensionality)
using sem_eq by auto
then show "(a, b) ∈ fml_sem I ($φ var (singleton θ) ↔ $φ var (singleton θ'))"
by auto
qed
theorem CE_sound: "CE_holds var φ ψ"
apply(simp only: CE_holds_def valid_def iff_sem)
apply(rule allI | rule impI)+
apply(simp)
apply(metis subsetI subset_antisym surj_pair)
done
end end
Theory Frechet_Correctness
theory "Frechet_Correctness"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Lib"
"Syntax"
"Denotational_Semantics"
"Ids"
begin
context ids begin
section ‹Characterization of Term Derivatives›
text ‹
This section builds up to a proof that in well-formed interpretations, all
terms have derivatives, and those derivatives agree with the expected rules
of derivatives. In particular, we show the [frechet] function given in the
denotational semantics is the true Frechet derivative of a term. From this
theorem we can recover all the standard derivative identities as corollaries.
›
lemma inner_prod_eq:
fixes i::"'a::finite"
shows "(λ(v::'a Rvec). v ∙ axis i 1) = (λ(v::'a Rvec). v $ i)"
unfolding cart_eq_inner_axis axis_def by (simp add: eq_commute)
theorem svar_deriv:
fixes x:: "'sv::finite" and ν:: "'sv Rvec" and F::"real filter"
shows "((λv. v $ x) has_derivative (λv'. v' ∙ (χ i. if i = x then 1 else 0))) (at ν)"
proof -
let ?f = "(λv. v)"
let ?f' = "(λv'. v')"
let ?g = "(λv. axis x 1)"
let ?g' = "(λv. 0)"
have id_deriv: "(?f has_derivative ?f') (at ν) "
by (rule has_derivative_ident)
have const_deriv: "(?g has_derivative ?g') (at ν)"
by (rule has_derivative_const)
have inner_deriv:"((λx. inner (?f x) (?g x)) has_derivative
(λh. inner (?f ν) (?g' h) + inner (?f' h) (?g ν))) (at ν)"
by (intro has_derivative_inner [OF id_deriv const_deriv])
from inner_prod_eq
have left_eq: "(λx. inner (?f x) (?g x)) = (λv. vec_nth v x)"
by (auto)
from inner_deriv and inner_prod_eq
have better_deriv:"((λv. vec_nth v x) has_derivative
(λh. inner (?f ν) (?g' h) + inner (?f' h) (?g ν))) (at ν)"
by (metis (no_types, lifting) UNIV_I has_derivative_transform)
have vec_eq:"(χ i. if i = x then 1 else 0) = (χ i. if x = i then 1 else 0)"
by(rule vec_extensionality, auto)
have deriv_eq:"(λh. ν ∙ 0 + h ∙ axis x 1) = (λv'. v' ∙ (χ i. if i = x then 1 else 0))"
by(rule ext, auto simp add: axis_def vec_eq)
show ?thesis
apply(rule has_derivative_eq_rhs[where f'= "(λh. ν ∙ 0 + h ∙ axis x 1)"])
using better_deriv deriv_eq by auto
qed
lemma function_case_inner:
assumes good_interp:
"(∀x i. (Functions I i has_derivative FunctionFrechet I i x) (at x))"
assumes IH:"((λv. χ i. sterm_sem I (args i) v)
has_derivative (λ v. (χ i. frechet I (args i) ν v))) (at ν)"
shows "((λv. Functions I f (χ i. sterm_sem I (args i) v))
has_derivative (λv. frechet I ($f f args) ν v)) (at ν)"
proof -
let ?h = "(λv. Functions I f (χ i. sterm_sem I (args i) v))"
let ?h' = "frechet I ($f f args) ν"
let ?g = "(λv. χ i. sterm_sem I (args i) v)"
let ?g' = "(λv. χ i. frechet I (args i) ν v)"
let ?f = "(λy. Functions I f y)"
let ?f' = "FunctionFrechet I f (?g ν)"
have hEqFG: "?h = ?f o ?g" by (auto)
have hEqFG': "?h' = ?f' o ?g'"
proof -
have frechet_def:"frechet I (Function f args) ν
= (λv'. FunctionFrechet I f (?g ν) (χ i. frechet I (args i) ν v'))"
by (auto)
have composition:
"(λv'. FunctionFrechet I f (?g ν) (χ i. frechet I (args i) ν v'))
= (FunctionFrechet I f (?g ν)) o (λ v'. χ i. frechet I (args i) ν v')"
by (auto)
from frechet_def and composition show ?thesis by (auto)
qed
have fDeriv: "(?f has_derivative ?f') (at (?g ν))"
using good_interp is_interp_def by blast
from IH have gDeriv: "(?g has_derivative ?g') (at ν)" by (auto)
from fDeriv and gDeriv
have composeDeriv: "((?f o ?g) has_derivative (?f' o ?g')) (at ν)"
using diff_chain_at good_interp by blast
from hEqFG hEqFG' composeDeriv show ?thesis by (auto)
qed
lemma func_lemma2:"(∀x i. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x) ∧
continuous_on UNIV (λx. Blinfun ((THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x))) ⟹
(⋀θ. θ ∈ range args ⟹ (sterm_sem I θ has_derivative frechet I θ ν) (at ν)) ⟹
((λv. Functions I f (vec_lambda(λi. sterm_sem I (args i) v))) has_derivative (λv'. (THE f'. ∀x. (Functions I f has_derivative f' x) (at x)) (χ i. sterm_sem I (args i) ν) (χ i. frechet I (args i) ν v'))) (at ν)"
proof -
assume a1: "∀x i. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x) ∧
continuous_on UNIV (λx. Blinfun ((THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x))"
then have a1':"∀x i. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)" by auto
assume a2: "⋀θ. θ ∈ range args ⟹ (sterm_sem I θ has_derivative frechet I θ ν) (at ν)"
have "∀f fa v. (∃fb. ¬ (f (fb::'a) has_derivative fa fb (v::(real, 'a) vec)) (at v)) ∨ ((λv. (χ fa. (f fa v::real))) has_derivative (λva. (χ f. fa f v va))) (at v)"
using has_derivative_vec by force
then have "((λv. χ f. sterm_sem I (args f) v) has_derivative (λv. χ f. frechet I (args f) ν v)) (at ν)"
by (auto simp add: a2 has_derivative_vec)
then show "((λv. Functions I f (vec_lambda(λf. sterm_sem I (args f) v))) has_derivative (λv'. (THE f'. ∀x. (Functions I f has_derivative f' x) (at x)) (χ i. sterm_sem I (args i) ν) (χ i. frechet I (args i) ν v'))) (at ν)"
using a1' function_case_inner by auto
qed
lemma func_lemma:
"is_interp I ⟹
(⋀θ :: ('a::finite, 'c::finite) trm. θ ∈ range args ⟹ (sterm_sem I θ has_derivative frechet I θ ν) (at ν)) ⟹
(sterm_sem I ($f f args) has_derivative frechet I ($f f args) ν) (at ν)"
apply(auto simp add: sfunction_case is_interp_def function_case_inner)
apply(erule func_lemma2)
apply(auto)
done
text ‹ The syntactic definition of term derivatives agrees with the semantic definition.
Since the syntactic definition of derivative is total, this gives us that derivatives are "decidable" for
terms (modulo computations on reals) and that they obey all the expected identities, which gives
us the axioms we want for differential terms essentially for free.
›
lemma frechet_correctness:
fixes I :: "('a::finite, 'b::finite, 'c::finite) interp" and ν
assumes good_interp: "is_interp I"
shows "dfree θ ⟹ FDERIV (sterm_sem I θ) ν :> (frechet I θ ν)"
proof (induct rule: dfree.induct)
case (dfree_Var i) then show ?case
by (auto simp add: svar_case svar_deriv axis_def)
next
case (dfree_Fun args i) with good_interp show ?case
by (intro func_lemma) auto
qed auto
text ‹If terms are semantically equivalent in all states, so are their derivatives›
lemma sterm_determines_frechet:
fixes I ::"('a1::finite, 'b1::finite, 'c::finite) interp"
and J ::"('a2::finite, 'b2::finite, 'c::finite) interp"
and θ1 :: "('a1::finite, 'c::finite) trm"
and θ2 :: "('a2::finite, 'c::finite) trm"
and ν
assumes good_interp1:"is_interp I"
assumes good_interp2:"is_interp J"
assumes free1:"dfree θ1"
assumes free2:"dfree θ2"
assumes sem:"sterm_sem I θ1 = sterm_sem J θ2"
shows "frechet I θ1 (fst ν) (snd ν) = frechet J θ2 (fst ν) (snd ν)"
proof -
have d1:"(sterm_sem I θ1 has_derivative (frechet I θ1 (fst ν))) (at (fst ν))"
using frechet_correctness[OF good_interp1 free1] by auto
have d2:"(sterm_sem J θ2 has_derivative (frechet J θ2 (fst ν))) (at (fst ν))"
using frechet_correctness[OF good_interp2 free2] by auto
then have d1':"(sterm_sem I θ1 has_derivative (frechet J θ2 (fst ν))) (at (fst ν))"
using sem by auto
thus "?thesis" using has_derivative_unique d1 d1' by metis
qed
lemma the_deriv:
assumes deriv:"(f has_derivative F) (at x)"
shows "(THE G. (f has_derivative G) (at x)) = F"
apply(rule the_equality)
subgoal by (rule deriv)
subgoal for G by (auto simp add: deriv has_derivative_unique)
done
lemma the_all_deriv:
assumes deriv:"∀x. (f has_derivative F x) (at x)"
shows "(THE G. ∀ x. (f has_derivative G x) (at x)) = F"
apply(rule the_equality)
subgoal by (rule deriv)
subgoal for G
apply(rule ext)
subgoal for x
apply(erule allE[where x=x])
by (auto simp add: deriv has_derivative_unique)
done
done
typedef ('a, 'c) strm = "{θ:: ('a,'c) trm. dfree θ}"
morphisms raw_term simple_term
by(rule exI[where x= "Const 0"], auto simp add: dfree_Const)
typedef ('a, 'b, 'c) good_interp = "{I::('a::finite,'b::finite,'c::finite) interp. is_interp I}"
morphisms raw_interp good_interp
apply(rule exI[where x="⦇ Functions = (λf x. 0), Predicates = (λp x. True), Contexts = (λC S. S), Programs = (λa. {}), ODEs = (λc v. (χ i. 0)), ODEBV = λc. {}⦈"])
apply(auto simp add: is_interp_def)
proof -
fix x ::real
have eq:"(THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) = (λ_ _. 0)"
by(rule the_all_deriv, auto)
have eq':"(THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) x = (λ_. 0)"
by (simp add: eq)
have deriv:"((λx.0) has_derivative (λx. 0)) (at x)"
by auto
then show "⋀x. ((λx. 0) has_derivative (THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) x) (at x)"
by (auto simp add: eq eq' deriv)
next
have eq:"(THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) = (λ_ _. 0)"
by(rule the_all_deriv, auto)
have eq':"∀x. (THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) x = (λ_. 0)"
by (simp add: eq)
have deriv:"⋀x. ((λx.0) has_derivative (λx. 0)) (at x)"
by auto
have blin:"⋀x. bounded_linear ((THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) x)"
by (simp add: eq')
show " continuous_on UNIV (λx. Blinfun ((THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) x))"
apply(clarsimp simp add: continuous_on_topological[of UNIV "(λx. Blinfun ((THE f'. ∀x. ((λx. 0) has_derivative f' x) (at x)) x))"])
apply(rule exI[where x = UNIV])
by(auto simp add: eq' blin)
qed
lemma frechet_linear:
assumes good_interp:"is_interp I"
fixes v θ
shows " dfree θ ⟹ bounded_linear (frechet I θ v)"
proof(induction rule: dfree.induct)
case (dfree_Var i)
then show ?case by(auto)
next
case (dfree_Const r)
then show ?case by auto
next
case (dfree_Fun args i)
have blin1:"⋀x. bounded_linear(FunctionFrechet I i x)"
using good_interp unfolding is_interp_def using has_derivative_bounded_linear
by blast
have blin2:"bounded_linear (λ a. (χ i. frechet I (args i) v a))"
using dfree_Fun.IH by(rule bounded_linear_vec)
then show ?case
using bounded_linear_compose[of "FunctionFrechet I i (χ i. sterm_sem I (args i) v)" "(λa. (χ i. frechet I (args i) v a))", OF blin1 blin2]
by auto
next
case (dfree_Plus θ⇩1 θ⇩2)
then show ?case
apply auto
using bounded_linear_add by (blast)
next
case (dfree_Times θ⇩1 θ⇩2)
then show ?case
by (auto simp add: bounded_linear_add bounded_linear_const_mult bounded_linear_mult_const)
qed
setup_lifting type_definition_good_interp
setup_lifting type_definition_strm
lift_definition blin_frechet::"('sf, 'sc, 'sz) good_interp ⇒ ('sf,'sz) strm ⇒ (real, 'sz) vec ⇒ (real, 'sz) vec ⇒⇩L real" is "frechet"
using frechet_linear by auto
lemmas [simp] = blin_frechet.rep_eq
lemma frechet_blin:"is_interp I ⟹ dfree θ ⟹ (λv. Blinfun (λv'. frechet I θ v v')) = blin_frechet (good_interp I) (simple_term θ)"
apply(rule ext)
apply(rule blinfun_eqI)
by (simp add: bounded_linear_Blinfun_apply frechet_linear good_interp_inverse simple_term_inverse)
lemma sterm_continuous:
assumes good_interp:"is_interp I"
shows "dfree θ ⟹ continuous_on UNIV (sterm_sem I θ)"
proof(induction rule: dfree.induct)
case (dfree_Fun args i)
assume IH:"⋀i. continuous_on UNIV (sterm_sem I (args i))"
have con1:"continuous_on UNIV (Functions I i)"
using good_interp unfolding is_interp_def
using continuous_on_eq_continuous_within has_derivative_continuous by blast
have con2:"continuous_on UNIV (λ x. (χ i. sterm_sem I (args i) x))"
apply(rule continuous_on_vec_lambda)
using IH by auto
have con:"continuous_on UNIV ((Functions I i) ∘ (λx. (χ i. sterm_sem I (args i) x)))"
apply(rule continuous_on_compose)
using con1 con2 apply auto
using continuous_on_subset by blast
show ?case
using con comp_def by(simp)
qed (auto intro: continuous_intros)
lemma sterm_continuous':
assumes good_interp:"is_interp I"
shows "dfree θ ⟹ continuous_on S (sterm_sem I θ)"
using sterm_continuous continuous_on_subset good_interp by blast
lemma frechet_continuous:
fixes I :: "('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"
shows "dfree θ ⟹ continuous_on UNIV (blin_frechet (good_interp I) (simple_term θ))"
proof (induction rule: dfree.induct)
case (dfree_Var i)
have free:"dfree (Var i)" by (rule dfree_Var)
have bounded_linear:"bounded_linear (λ ν'. ν' ∙ axis i 1)"
by (auto simp add: bounded_linear_vec_nth)
have cont:"continuous_on UNIV (λν. Blinfun(λ ν'. ν' ∙ axis i 1))"
using continuous_on_const by blast
have eq:"⋀ν ν'. (λν. Blinfun(λ ν'. ν' ∙ axis i 1)) ν ν' = (blin_frechet (good_interp I) (simple_term (Var i))) ν ν'"
unfolding axis_def apply(auto)
by (metis (no_types) axis_def blinfun_inner_left.abs_eq blinfun_inner_left.rep_eq dfree_Var_simps frechet.simps(1) mem_Collect_eq simple_term_inverse)
have eq':"(λν. Blinfun(λ ν'. ν' ∙ axis i 1)) = (blin_frechet (good_interp I) (simple_term (Var i)))"
apply(rule ext)
apply(rule blinfun_eqI)
using eq by auto
then show ?case by (metis cont)
next
case (dfree_Const r)
have free:"dfree (Const r)" by (rule dfree_Const)
have bounded_linear:"bounded_linear (λ ν'. 0)" by (simp)
have cont:"continuous_on UNIV (λν. Blinfun(λ ν'. 0))"
using continuous_on_const by blast
have eq':"(λν. Blinfun(λ ν'. 0)) = (blin_frechet (good_interp I) (simple_term (Const r)))"
apply(rule ext)
apply(rule blinfun_eqI)
apply auto
using zero_blinfun.abs_eq zero_blinfun.rep_eq free
by (metis frechet.simps(5) mem_Collect_eq simple_term_inverse)
then show ?case by (metis cont)
next
case (dfree_Fun args f)
assume IH:"⋀i. continuous_on UNIV (blin_frechet (good_interp I) (simple_term (args i)))"
assume frees:"(⋀i. dfree (args i))"
then have free:"dfree ($f f args)" by (auto)
have great_interp:"⋀f. continuous_on UNIV (λx. Blinfun (FunctionFrechet I f x))" using good_interp unfolding is_interp_def by auto
have cont1:"⋀v. continuous_on UNIV (λv'. (χ i. frechet I (args i) v v'))"
apply(rule continuous_on_vec_lambda)
using IH by (simp add: frechet_linear frees good_interp linear_continuous_on)
have eq:"(λv. Blinfun(λv'. FunctionFrechet I f (χ i. sterm_sem I (args i) v) (χ i. frechet I (args i) v v')))
= (blin_frechet (good_interp I) (simple_term (Function f args)))"
using frechet_blin[OF good_interp free] by auto
have bounded_linears:"⋀x. bounded_linear (FunctionFrechet I f x)" using good_interp unfolding is_interp_def by blast
let ?blin_ff ="(λx. Blinfun (FunctionFrechet I f x))"
have some_eq:"(λx. Blinfun (FunctionFrechet I f (χ i. sterm_sem I (args i) x))) =
((?blin_ff) ∘ (λx. (χ i. sterm_sem I (args i) x)))"
apply(rule ext)
apply(rule blinfun_eqI)
unfolding comp_def by blast
have sub_cont:"continuous_on UNIV ((?blin_ff) ∘ (λx. (χ i. sterm_sem I (args i) x)))"
apply(rule continuous_intros)+
apply (simp add: frees good_interp sterm_continuous')
using continuous_on_subset great_interp by blast
have blin_frech_vec:"⋀x. bounded_linear (λv'. χ i. frechet I (args i) x v')"
by (simp add: bounded_linear_vec frechet_linear frees good_interp)
have frech_vec_eq:"(λx. Blinfun (λv'. χ i. frechet I (args i) x v')) = (λx. blinfun_vec (λ i. blin_frechet (good_interp I) (simple_term (args i)) x))"
apply(rule ext)
apply(rule blinfun_eqI)
apply(rule vec_extensionality)
subgoal for x i j
using blin_frech_vec[of x]
apply auto
by (metis (no_types, lifting) blin_frechet.rep_eq bounded_linear_Blinfun_apply frechet_blin frechet_linear frees good_interp vec_lambda_beta)
done
have cont_frech_vec:"continuous_on UNIV (λx. blinfun_vec (λ i. blin_frechet (good_interp I) (simple_term (args i)) x))"
apply(rule continuous_blinfun_vec')
using IH by blast
have cont_intro:"⋀ s f g. continuous_on s f ⟹ continuous_on s g ⟹ continuous_on s (λx. f x o⇩L g x)"
by (auto intro: continuous_intros)
have cont:"continuous_on UNIV (λv. blinfun_compose (Blinfun (FunctionFrechet I f (χ i. sterm_sem I (args i) v))) (Blinfun(λv'. (χ i. frechet I (args i) v v'))))"
apply(rule cont_intro)
subgoal using sub_cont by simp
using frech_vec_eq cont_frech_vec by presburger
have best_eq:"(blin_frechet (good_interp I) (simple_term ($f f args))) = (λv. blinfun_compose (Blinfun (FunctionFrechet I f (χ i. sterm_sem I (args i) v))) (Blinfun(λv'. (χ i. frechet I (args i) v v')))) "
apply(rule ext)
apply(rule blinfun_eqI)
proof -
fix v :: "(real, 'sz) vec" and i :: "(real, 'sz) vec"
have "frechet I ($f f args) v i = blinfun_apply (blin_frechet (good_interp I) (simple_term ($f f args)) v) i"
by (metis (no_types) bounded_linear_Blinfun_apply dfree_Fun_simps frechet_blin frechet_linear frees good_interp)
then have "FunctionFrechet I f (χ s. sterm_sem I (args s) v) (blinfun_apply (Blinfun (λva. χ s. frechet I (args s) v va)) i) = blinfun_apply (blin_frechet (good_interp I) (simple_term ($f f args)) v) i"
by (simp add: blin_frech_vec bounded_linear_Blinfun_apply)
then show "blinfun_apply (blin_frechet (good_interp I) (simple_term ($f f args)) v) i = blinfun_apply (Blinfun (FunctionFrechet I f (χ s. sterm_sem I (args s) v)) o⇩L Blinfun (λva. χ s. frechet I (args s) v va)) i"
by (metis (no_types) blinfun_apply_blinfun_compose bounded_linear_Blinfun_apply bounded_linears)
qed
then show ?case using cont best_eq by auto
next
case (dfree_Plus θ⇩1 θ⇩2)
assume IH1:"continuous_on UNIV (blin_frechet (good_interp I) (simple_term θ⇩1))"
assume IH2:"continuous_on UNIV (blin_frechet (good_interp I) (simple_term θ⇩2))"
assume free1:"dfree θ⇩1"
assume free2:"dfree θ⇩2"
have free:"dfree (Plus θ⇩1 θ⇩2)" using free1 free2 by auto
have bounded_linear:"⋀v. bounded_linear (λv'. frechet I θ⇩1 v v' + frechet I θ⇩2 v v')"
subgoal for v
using frechet_linear[OF good_interp free] by auto
done
have eq2:"(λv. blin_frechet (good_interp I) (simple_term θ⇩1) v + blin_frechet (good_interp I) (simple_term θ⇩2) v) = blin_frechet (good_interp I) (simple_term (Plus θ⇩1 θ⇩2))"
apply(rule ext)
apply(rule blinfun_eqI)
by (simp add: blinfun.add_left free1 free2 simple_term_inverse)
have cont:"continuous_on UNIV (λv. blin_frechet (good_interp I) (simple_term θ⇩1) v + blin_frechet (good_interp I) (simple_term θ⇩2) v)"
using continuous_on_add dfree_Plus.IH(1) dfree_Plus.IH(2) by blast
then show ?case using cont eq2 by metis
next
case (dfree_Times θ⇩1 θ⇩2)
assume IH1:"continuous_on UNIV (blin_frechet (good_interp I) (simple_term θ⇩1))"
assume IH2:"continuous_on UNIV (blin_frechet (good_interp I) (simple_term θ⇩2))"
assume free1:"dfree θ⇩1"
assume free2:"dfree θ⇩2"
have free:"dfree (Times θ⇩1 θ⇩2)" using free1 free2 by auto
have bounded_linear:"⋀v. bounded_linear (λv'. sterm_sem I θ⇩1 v * frechet I θ⇩2 v v' + frechet I θ⇩1 v v' * sterm_sem I θ⇩2 v)"
apply(rule bounded_linear_add)
apply(rule bounded_linear_const_mult)
using frechet_linear[OF good_interp free2] apply auto
apply(rule bounded_linear_mult_const)
using frechet_linear[OF good_interp free1] by auto
then have blin':"⋀v. (λv'. sterm_sem I θ⇩1 v * frechet I θ⇩2 v v' + frechet I θ⇩1 v v' * sterm_sem I θ⇩2 v) ∈ {f. bounded_linear f}" by auto
have blinfun_eq:"⋀v. Blinfun (λv'. sterm_sem I θ⇩1 v * frechet I θ⇩2 v v' + frechet I θ⇩1 v v' * sterm_sem I θ⇩2 v)
= scaleR (sterm_sem I θ⇩1 v) (blin_frechet (good_interp I) (simple_term θ⇩2) v) + scaleR (sterm_sem I θ⇩2 v) (blin_frechet (good_interp I) (simple_term θ⇩1) v)"
apply(rule blinfun_eqI)
subgoal for v i
using Blinfun_inverse[OF blin', of v] apply auto
using blinfun.add_left[of "sterm_sem I θ⇩1 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩2) v" "sterm_sem I θ⇩2 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩1) v"]
blinfun.scaleR_left[of "sterm_sem I θ⇩1 v" "blin_frechet (good_interp I) (simple_term θ⇩2) v"]
blinfun.scaleR_left[of "sterm_sem I θ⇩2 v" "blin_frechet (good_interp I) (simple_term θ⇩1) v"]
bounded_linear_Blinfun_apply
frechet_blin[OF good_interp free1]
frechet_blin[OF good_interp free2]
frechet_linear[OF good_interp free1]
frechet_linear[OF good_interp free2]
mult.commute
real_scaleR_def
proof -
have f1: "⋀v. blinfun_apply (blin_frechet (good_interp I) (simple_term θ⇩1) v) = frechet I θ⇩1 v"
by (metis (no_types) ‹(λv. Blinfun (frechet I θ⇩1 v)) = blin_frechet (good_interp I) (simple_term θ⇩1)› ‹⋀v. bounded_linear (frechet I θ⇩1 v)› bounded_linear_Blinfun_apply)
have "⋀v. blinfun_apply (blin_frechet (good_interp I) (simple_term θ⇩2) v) = frechet I θ⇩2 v"
by (metis (no_types) ‹(λv. Blinfun (frechet I θ⇩2 v)) = blin_frechet (good_interp I) (simple_term θ⇩2)› ‹⋀v. bounded_linear (frechet I θ⇩2 v)› bounded_linear_Blinfun_apply)
then show "sterm_sem I θ⇩1 v * frechet I θ⇩2 v i + frechet I θ⇩1 v i * sterm_sem I θ⇩2 v = blinfun_apply (sterm_sem I θ⇩1 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩2) v + sterm_sem I θ⇩2 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩1) v) i"
using f1 by (simp add: ‹⋀b. blinfun_apply (sterm_sem I θ⇩1 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩2) v + sterm_sem I θ⇩2 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩1) v) b = blinfun_apply (sterm_sem I θ⇩1 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩2) v) b + blinfun_apply (sterm_sem I θ⇩2 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩1) v) b› ‹⋀b. blinfun_apply (sterm_sem I θ⇩1 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩2) v) b = sterm_sem I θ⇩1 v *⇩R blinfun_apply (blin_frechet (good_interp I) (simple_term θ⇩2) v) b› ‹⋀b. blinfun_apply (sterm_sem I θ⇩2 v *⇩R blin_frechet (good_interp I) (simple_term θ⇩1) v) b = sterm_sem I θ⇩2 v *⇩R blinfun_apply (blin_frechet (good_interp I) (simple_term θ⇩1) v) b›)
qed
done
have cont':"continuous_on UNIV
(λv. scaleR (sterm_sem I θ⇩1 v) (blin_frechet (good_interp I) (simple_term θ⇩2) v)
+ scaleR (sterm_sem I θ⇩2 v) (blin_frechet (good_interp I) (simple_term θ⇩1) v))"
apply(rule continuous_on_add)
apply(rule continuous_on_scaleR)
apply(rule sterm_continuous[OF good_interp free1])
apply(rule IH2)
apply(rule continuous_on_scaleR)
apply(rule sterm_continuous[OF good_interp free2])
by(rule IH1)
have cont:"continuous_on UNIV (λv. Blinfun (λv'. sterm_sem I θ⇩1 v * frechet I θ⇩2 v v' + frechet I θ⇩1 v v' * sterm_sem I θ⇩2 v))"
using cont' blinfun_eq by auto
have eq:"(λv. Blinfun (λv'. sterm_sem I θ⇩1 v * frechet I θ⇩2 v v' + frechet I θ⇩1 v v' * sterm_sem I θ⇩2 v)) = blin_frechet (good_interp I) (simple_term (Times θ⇩1 θ⇩2))"
using frechet_blin[OF good_interp free]
by auto
then show ?case by (metis cont)
qed
end end
Theory Static_Semantics
theory "Static_Semantics"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Frechet_Correctness"
begin
section ‹Static Semantics›
text ‹This section introduces functions for computing properties of the static semantics, specifically
the following dependencies:
\begin{itemize}
\item Signatures: Symbols (from the interpretation) which influence the result of a term, ode, formula, program
\item Free variables: Variables (from the state) which influence the result of a term, ode, formula, program
\item Bound variables: Variables (from the state) that *might* be influenced by a program
\item Must-bound variables: Variables (from the state) that are *always* influenced by a program (i.e.
will never depend on anything other than the free variables of that program)
\end{itemize}
We also prove basic lemmas about these definitions, but their overall correctness is proved elsewhere
in the Bound Effect and Coincidence theorems.
›
subsection ‹Signature Definitions›
primrec SIGT :: "('a, 'c) trm ⇒ 'a set"
where
"SIGT (Var var) = {}"
| "SIGT (Const r) = {}"
| "SIGT (Function var f) = {var} ∪ (⋃i. SIGT (f i))"
| "SIGT (Plus t1 t2) = SIGT t1 ∪ SIGT t2"
| "SIGT (Times t1 t2) = SIGT t1 ∪ SIGT t2"
| "SIGT (DiffVar x) = {}"
| "SIGT (Differential t) = SIGT t"
primrec SIGO :: "('a, 'c) ODE ⇒ ('a + 'c) set"
where
"SIGO (OVar c) = {Inr c}"
| "SIGO (OSing x θ) = {Inl x| x. x ∈ SIGT θ}"
| "SIGO (OProd ODE1 ODE2) = SIGO ODE1 ∪ SIGO ODE2"
primrec SIGP :: "('a, 'b, 'c) hp ⇒ ('a + 'b + 'c) set"
and SIGF :: "('a, 'b, 'c) formula ⇒ ('a + 'b + 'c) set"
where
"SIGP (Pvar var) = {Inr (Inr var)}"
| "SIGP (Assign var t) = {Inl x | x. x ∈ SIGT t}"
| "SIGP (DiffAssign var t) = {Inl x | x. x ∈ SIGT t}"
| "SIGP (Test p) = SIGF p"
| "SIGP (EvolveODE ODE p) = SIGF p ∪ {Inl x | x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) | x. Inr x ∈ SIGO ODE}"
| "SIGP (Choice a b) = SIGP a ∪ SIGP b"
| "SIGP (Sequence a b) = SIGP a ∪ SIGP b"
| "SIGP (Loop a) = SIGP a"
| "SIGF (Geq t1 t2) = {Inl x | x. x ∈ SIGT t1 ∪ SIGT t2}"
| "SIGF (Prop var args) = {Inr (Inr var)} ∪ {Inl x | x. x ∈ (⋃i. SIGT (args i))}"
| "SIGF (Not p) = SIGF p"
| "SIGF (And p1 p2) = SIGF p1 ∪ SIGF p2"
| "SIGF (Exists var p) = SIGF p"
| "SIGF (Diamond a p) = SIGP a ∪ SIGF p"
| "SIGF (InContext var p) = {Inr (Inl var)} ∪ SIGF p"
fun primify :: "('a + 'a) ⇒ ('a + 'a) set"
where
"primify (Inl x) = {Inl x, Inr x}"
| "primify (Inr x) = {Inl x, Inr x}"
subsection ‹Variable Binding Definitions›
text‹
We represent the (free or bound or must-bound) variables of a term as an (id + id) set,
where all the (Inl x) elements are unprimed variables x and all the (Inr x) elements are
primed variables x'.
›
text‹Free variables of a term ›
primrec FVT :: "('a, 'c) trm ⇒ ('c + 'c) set"
where
"FVT (Var x) = {Inl x}"
| "FVT (Const x) = {}"
| "FVT (Function f args) = (⋃i. FVT (args i))"
| "FVT (Plus f g) = FVT f ∪ FVT g"
| "FVT (Times f g) = FVT f ∪ FVT g"
| "FVT (Differential f) = (⋃x ∈ (FVT f). primify x)"
| "FVT (DiffVar x) = {Inr x}"
fun FVDiff :: "('a, 'c) trm ⇒ ('c + 'c) set"
where "FVDiff f = (⋃x ∈ (FVT f). primify x)"
text‹ Free variables of an ODE includes both the bound variables and the terms ›
fun FVO :: "('a, 'c) ODE ⇒ 'c set"
where
"FVO (OVar c) = UNIV"
| "FVO (OSing x θ) = {x} ∪ {x . Inl x ∈ FVT θ}"
| "FVO (OProd ODE1 ODE2) = FVO ODE1 ∪ FVO ODE2"
text‹ Bound variables of ODEs, formulas, programs ›
fun BVO :: "('a, 'c) ODE ⇒ ('c + 'c) set"
where
"BVO (OVar c) = UNIV"
| "BVO (OSing x θ) = {Inl x, Inr x}"
| "BVO (OProd ODE1 ODE2) = BVO ODE1 ∪ BVO ODE2"
fun BVF :: "('a, 'b, 'c) formula ⇒ ('c + 'c) set"
and BVP :: "('a, 'b, 'c) hp ⇒ ('c + 'c) set"
where
"BVF (Geq f g) = {}"
| "BVF (Prop p dfun_args) = {}"
| "BVF (Not p) = BVF p"
| "BVF (And p q) = BVF p ∪ BVF q"
| "BVF (Exists x p) = {Inl x} ∪ BVF p"
| "BVF (Diamond α p) = BVP α ∪ BVF p"
| "BVF (InContext C p) = UNIV"
| "BVP (Pvar a) = UNIV"
| "BVP (Assign x θ) = {Inl x}"
| "BVP (DiffAssign x θ) = {Inr x}"
| "BVP (Test φ) = {}"
| "BVP (EvolveODE ODE φ) = BVO ODE"
| "BVP (Choice α β) = BVP α ∪ BVP β"
| "BVP (Sequence α β) = BVP α ∪ BVP β"
| "BVP (Loop α) = BVP α"
text‹ Must-bound variables (of a program)›
fun MBV :: "('a, 'b, 'c) hp ⇒ ('c + 'c) set"
where
"MBV (Pvar a) = {}"
| "MBV (Choice α β) = MBV α ∩ MBV β"
| "MBV (Sequence α β) = MBV α ∪ MBV β"
| "MBV (Loop α) = {}"
| "MBV (EvolveODE ODE _) = (Inl ` (ODE_dom ODE)) ∪ (Inr ` (ODE_dom ODE))"
| "MBV α = BVP α"
text‹Free variables of a formula,
free variables of a program ›
fun FVF :: "('a, 'b, 'c) formula ⇒ ('c + 'c) set"
and FVP :: "('a, 'b, 'c) hp ⇒ ('c + 'c) set"
where
"FVF (Geq f g) = FVT f ∪ FVT g"
| "FVF (Prop p args) = (⋃i. FVT (args i))"
| "FVF (Not p) = FVF p"
| "FVF (And p q) = FVF p ∪ FVF q"
| "FVF (Exists x p) = FVF p - {Inl x}"
| "FVF (Diamond α p) = FVP α ∪ (FVF p - MBV α)"
| "FVF (InContext C p) = UNIV"
| "FVP (Pvar a) = UNIV"
| "FVP (Assign x θ) = FVT θ"
| "FVP (DiffAssign x θ) = FVT θ"
| "FVP (Test φ) = FVF φ"
| "FVP (EvolveODE ODE φ) = BVO ODE ∪ (Inl ` FVO ODE) ∪ FVF φ"
| "FVP (Choice α β) = FVP α ∪ FVP β"
| "FVP (Sequence α β) = FVP α ∪ (FVP β - MBV α)"
| "FVP (Loop α) = FVP α"
subsection ‹Lemmas for reasoning about static semantics›
lemma primify_contains:"x ∈ primify x"
by (cases "x") auto
lemma FVDiff_sub:"FVT f ⊆ FVDiff f"
by (auto simp add: primify_contains)
lemma fvdiff_plus1:"FVDiff (Plus t1 t2) = FVDiff t1 ∪ FVDiff t2"
by (auto)
lemma agree_func_fvt:"Vagree ν ν' (FVT (Function f args)) ⟹ Vagree ν ν' (FVT (args i))"
by (auto simp add: Set.Un_upper1 agree_supset Vagree_def)
lemma agree_plus1:"Vagree ν ν' (FVDiff (Plus t1 t2)) ⟹ Vagree ν ν' (FVDiff t1)"
proof -
assume agree:"Vagree ν ν' (FVDiff (Plus t1 t2))"
have agree':"Vagree ν ν' ((⋃i∈FVT t1. primify i) ∪ (⋃i∈FVT t2. primify i))"
using fvdiff_plus1 FVDiff.simps agree by (auto)
have agreeL:"Vagree ν ν' ((⋃i∈FVT t1. primify i))"
using agree' agree_supset Set.Un_upper1 by (blast)
show "Vagree ν ν' (FVDiff t1)" using agreeL by (auto)
qed
lemma agree_plus2:"Vagree ν ν' (FVDiff (Plus t1 t2)) ⟹ Vagree ν ν' (FVDiff t2)"
proof -
assume agree:"Vagree ν ν' (FVDiff (Plus t1 t2))"
have agree':"Vagree ν ν' ((⋃i∈FVT t1. primify i) ∪ (⋃i∈FVT t2. primify i))"
using fvdiff_plus1 FVDiff.simps agree by (auto)
have agreeR:"Vagree ν ν' ((⋃i∈FVT t2. primify i))"
using agree' agree_supset Set.Un_upper1 by (blast)
show "Vagree ν ν' (FVDiff t2)" using agreeR by (auto)
qed
lemma agree_times1:"Vagree ν ν' (FVDiff (Times t1 t2)) ⟹ Vagree ν ν' (FVDiff t1)"
proof -
assume agree:"Vagree ν ν' (FVDiff (Times t1 t2))"
have agree':"Vagree ν ν' ((⋃i∈FVT t1. primify i) ∪ (⋃i∈FVT t2. primify i))"
using fvdiff_plus1 FVDiff.simps agree by (auto)
have agreeL:"Vagree ν ν' ((⋃i∈FVT t1. primify i))"
using agree' agree_supset Set.Un_upper1 by (blast)
show "Vagree ν ν' (FVDiff t1)" using agreeL by (auto)
qed
lemma agree_times2:"Vagree ν ν' (FVDiff (Times t1 t2)) ⟹ Vagree ν ν' (FVDiff t2)"
proof -
assume agree:"Vagree ν ν' (FVDiff (Times t1 t2))"
have agree':"Vagree ν ν' ((⋃i∈FVT t1. primify i) ∪ (⋃i∈FVT t2. primify i))"
using fvdiff_plus1 FVDiff.simps agree by (auto)
have agreeR:"Vagree ν ν' ((⋃i∈FVT t2. primify i))"
using agree' agree_supset Set.Un_upper1 by (blast)
show "Vagree ν ν' (FVDiff t2)" using agreeR by (auto)
qed
lemma agree_func:"Vagree ν ν' (FVDiff ($f var args)) ⟹ (⋀i. Vagree ν ν' (FVDiff (args i)))"
proof -
assume agree:"Vagree ν ν' (FVDiff ($f var args))"
have agree':"Vagree ν ν' ((⋃i. (⋃j ∈(FVT (args i)). primify j)))"
using fvdiff_plus1 FVDiff.simps agree by (auto)
fix i :: 'a
have "⋀S. ¬ S ⊆ (⋃f. ⋃ (primify ` FVT (args f))) ∨ Vagree ν ν' S"
using agree' agree_supset by blast
then have "⋀f. f ∉ UNIV ∨ Vagree ν ν' (⋃ (primify ` FVT (args f)))"
by blast
then show "Vagree ν ν' (FVDiff (args i))"
by simp
qed
end
Theory Coincidence
theory "Coincidence"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Frechet_Correctness"
"Static_Semantics"
begin
section ‹Coincidence Theorems and Corollaries›
text ‹This section proves coincidence: semantics of terms, odes, formulas and programs depend only
on the free variables. This is one of the major lemmas for the correctness of uniform substitutions.
Along the way, we also prove the equivalence between two similar, but different semantics for ODE programs:
It does not matter whether the semantics of ODE's insist on the existence of a solution that agrees
with the start state on all variables vs. one that agrees only on the variables that are actually
relevant to the ODE. This is proven here by simultaneous induction with the coincidence theorem
for the following reason:
The reason for having two different semantics is that some proofs are easier with one semantics
and other proofs are easier with the other definition. The coincidence proof is either with the
more complicated definition, which should not be used as the main definition because it would make
the specification for the dL semantics significantly larger, effectively increasing the size of
the trusted core. However, that the proof of equivalence between the semantics using the coincidence
lemma for formulas. In order to use the coincidence proof in the equivalence proof and the equivalence
proof in the coincidence proof, they are proved by simultaneous induction.
›
context ids begin
subsection ‹Term Coincidence Theorems›
lemma coincidence_sterm:"Vagree ν ν' (FVT θ) ⟹ sterm_sem I θ (fst ν) = sterm_sem I θ (fst ν')"
apply(induct "θ")
apply(auto simp add: Vagree_def)
by (meson rangeI)
lemma coincidence_sterm':"dfree θ ⟹ Vagree ν ν' (FVT θ) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ} ⟹ sterm_sem I θ (fst ν) = sterm_sem J θ (fst ν')"
proof (induction rule: dfree.induct)
case (dfree_Fun args i)
then show ?case
proof (auto)
assume free:"(⋀i. dfree (args i))"
and IH:"(⋀i. Vagree ν ν' (FVT (args i)) ⟹ Iagree I J {Inl x |x. x ∈ SIGT (args i)} ⟹ sterm_sem I (args i) (fst ν) = sterm_sem J (args i) (fst ν'))"
and VA:"Vagree ν ν' (⋃i. FVT (args i))"
and IA:"Iagree I J {Inl x |x. x = i ∨ (∃xa. x ∈ SIGT (args xa))}"
from IA have IAorig:"Iagree I J {Inl x |x. x ∈ SIGT (Function i args)}" by auto
from Iagree_Func[OF IAorig] have eqF:"Functions I i = Functions J i" by auto
have Vsubs:"⋀i. FVT (args i) ⊆ (⋃i. FVT (args i))" by auto
from VA
have VAs:"⋀i. Vagree ν ν' (FVT (args i))"
using agree_sub[OF Vsubs] by auto
have Isubs:"⋀j. {Inl x |x. x ∈ SIGT (args j)} ⊆ {Inl x |x. x ∈ SIGT (Function i args)}"
by auto
from IA
have IAs:"⋀i. Iagree I J {Inl x |x. x ∈ SIGT (args i)}"
using Iagree_sub[OF Isubs] by auto
show "Functions I i (χ i. sterm_sem I (args i) (fst ν)) = Functions J i (χ i. sterm_sem J (args i) (fst ν'))"
using IH[OF VAs IAs] eqF by auto
qed
next
case (dfree_Plus θ⇩1 θ⇩2)
then show ?case
proof (auto)
assume "dfree θ⇩1" "dfree θ⇩2"
and IH1:"(Vagree ν ν' (FVT θ⇩1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩1} ⟹ sterm_sem I θ⇩1 (fst ν) = sterm_sem J θ⇩1 (fst ν'))"
and IH2:"(Vagree ν ν' (FVT θ⇩2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩2} ⟹ sterm_sem I θ⇩2 (fst ν) = sterm_sem J θ⇩2 (fst ν'))"
and VA:"Vagree ν ν' (FVT θ⇩1 ∪ FVT θ⇩2)"
and IA:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩1 ∨ x ∈ SIGT θ⇩2}"
from VA
have VAs:"Vagree ν ν' (FVT θ⇩1)" "Vagree ν ν' (FVT θ⇩2)"
unfolding Vagree_def by auto
have Isubs:"{Inl x |x. x ∈ SIGT θ⇩1} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩1 θ⇩2)}"
"{Inl x |x. x ∈ SIGT θ⇩2} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩1 θ⇩2)}"
by auto
from IA
have IAs:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩1}"
"Iagree I J {Inl x |x. x ∈ SIGT θ⇩2}"
using Iagree_sub[OF Isubs(1)] Iagree_sub[OF Isubs(2)] by auto
show "sterm_sem I θ⇩1 (fst ν) + sterm_sem I θ⇩2 (fst ν) = sterm_sem J θ⇩1 (fst ν') + sterm_sem J θ⇩2 (fst ν')"
using IH1[OF VAs(1) IAs(1)] IH2[OF VAs(2) IAs(2)] by auto
qed
next
case (dfree_Times θ⇩1 θ⇩2)
then show ?case
proof (auto)
assume "dfree θ⇩1" "dfree θ⇩2"
and IH1:"(Vagree ν ν' (FVT θ⇩1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩1} ⟹ sterm_sem I θ⇩1 (fst ν) = sterm_sem J θ⇩1 (fst ν'))"
and IH2:"(Vagree ν ν' (FVT θ⇩2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩2} ⟹ sterm_sem I θ⇩2 (fst ν) = sterm_sem J θ⇩2 (fst ν'))"
and VA:"Vagree ν ν' (FVT θ⇩1 ∪ FVT θ⇩2)"
and IA:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩1 ∨ x ∈ SIGT θ⇩2}"
from VA
have VAs:"Vagree ν ν' (FVT θ⇩1)" "Vagree ν ν' (FVT θ⇩2)"
unfolding Vagree_def by auto
have Isubs:"{Inl x |x. x ∈ SIGT θ⇩1} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩1 θ⇩2)}"
"{Inl x |x. x ∈ SIGT θ⇩2} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩1 θ⇩2)}"
by auto
from IA
have IAs:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩1}"
"Iagree I J {Inl x |x. x ∈ SIGT θ⇩2}"
using Iagree_sub[OF Isubs(1)] Iagree_sub[OF Isubs(2)] by auto
show "sterm_sem I θ⇩1 (fst ν) * sterm_sem I θ⇩2 (fst ν) = sterm_sem J θ⇩1 (fst ν') * sterm_sem J θ⇩2 (fst ν')"
using IH1[OF VAs(1) IAs(1)] IH2[OF VAs(2) IAs(2)] by auto
qed
qed (unfold Vagree_def Iagree_def, auto)
lemma sum_unique_nonzero:
fixes i::"'sv::finite" and f::"'sv ⇒ real"
assumes restZero:"⋀j. j∈(UNIV::'sv set) ⟹ j ≠ i ⟹ f j = 0"
shows "(∑j∈(UNIV::'sv set). f j) = f i"
proof -
have "(∑j∈(UNIV::'sv set). f j) = (∑j∈{i}. f j)"
using restZero by (intro sum.mono_neutral_cong_right) auto
then show ?thesis
by simp
qed
lemma coincidence_frechet :
fixes I :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c state" and ν'::"'c state"
shows "dfree θ ⟹ Vagree ν ν' (FVDiff θ) ⟹ frechet I θ (fst ν) (snd ν) = frechet I θ (fst ν') (snd ν')"
proof (induction rule: dfree.induct)
case dfree_Var then show ?case
by (auto simp: inner_prod_eq Vagree_def)
next
case dfree_Const then show ?case
by auto
next
case (dfree_Fun args var)
assume free:"(⋀i. dfree (args i))"
assume IH:"(⋀i. Vagree ν ν' (FVDiff (args i)) ⟹ frechet I (args i) (fst ν) (snd ν) = frechet I (args i) (fst ν') (snd ν'))"
have frees:"(⋀i. dfree (args i))" using free by (auto simp add: rangeI)
assume agree:"Vagree ν ν' (FVDiff ($f var args))"
have agrees:"⋀i. Vagree ν ν' (FVDiff (args i))" using agree agree_func by metis
have agrees':"⋀i. Vagree ν ν' (FVT (args i))"
subgoal for i
using agrees[of i] FVDiff_sub[of "args i"] unfolding Vagree_def by blast
done
have sterms:"⋀i. sterm_sem I (args i) (fst ν) = sterm_sem I (args i) (fst ν')"
by (rule coincidence_sterm[of "ν" "ν'", OF agrees'])
have frechets:"⋀i. frechet I (args i) (fst ν) (snd ν) = frechet I (args i) (fst ν') (snd ν')" using IH agrees frees rangeI by blast
show "?case"
using agrees sterms frechets by (auto)
next
case (dfree_Plus t1 t2)
assume dfree1:"dfree t1"
assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
assume dfree2:"dfree t2"
assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
assume agree:"Vagree ν ν' (FVDiff (Plus t1 t2))"
have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_plus1 by (blast)
have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_plus2 by (blast)
have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
using IH1 agree1 by (auto)
have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
using IH2 agree2 by (auto)
show "?case"
by (metis FVT.simps(4) IH1' IH2' UnCI Vagree_def coincidence_sterm frechet.simps(3) mem_Collect_eq)
next
case (dfree_Times t1 t2)
assume dfree1:"dfree t1"
assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
assume dfree2:"dfree t2"
assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
assume agree:"Vagree ν ν' (FVDiff (Times t1 t2))"
have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_times1 by blast
have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_times2 by blast
have agree1':"Vagree ν ν' (FVT t1)"
using agree1 apply(auto simp add: Vagree_def)
using primify_contains by blast+
have agree2':"Vagree ν ν' (FVT t2)"
using agree2 apply(auto simp add: Vagree_def)
using primify_contains by blast+
have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet I t1 (fst ν') (snd ν'))"
using IH1 agree1 by (auto)
have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet I t2 (fst ν') (snd ν'))"
using IH2 agree2 by (auto)
have almost:"Vagree ν ν' (FVT (Times t1 t2)) ⟹ frechet I (Times t1 t2) (fst ν) (snd ν) = frechet I (Times t1 t2) (fst ν') (snd ν')"
by (auto simp add: UnCI Vagree_def agree IH1' IH2' coincidence_sterm[OF agree1', of I] coincidence_sterm[OF agree2', of I])
show "?case"
using agree FVDiff_sub almost
by (metis agree_supset)
qed
lemma coincidence_frechet' :
fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c state" and ν'::"'c state"
shows "dfree θ ⟹ Vagree ν ν' (FVDiff θ) ⟹ Iagree I J {Inl x | x. x ∈ (SIGT θ)} ⟹ frechet I θ (fst ν) (snd ν) = frechet J θ (fst ν') (snd ν')"
proof (induction rule: dfree.induct)
case dfree_Var then show ?case
by (auto simp: inner_prod_eq Vagree_def)
next
case dfree_Const then show ?case
by auto
next
case (dfree_Fun args var)
assume free:"(⋀i. dfree (args i))"
assume IH:"(⋀i. Vagree ν ν' (FVDiff (args i)) ⟹ Iagree I J {Inl x |x. x ∈ SIGT (args i)} ⟹ frechet I (args i) (fst ν) (snd ν) = frechet J (args i) (fst ν') (snd ν'))"
have frees:"(⋀i. dfree (args i))" using free by (auto simp add: rangeI)
assume agree:"Vagree ν ν' (FVDiff ($f var args))"
assume IA:"Iagree I J {Inl x |x. x ∈ SIGT ($f var args)}"
have agrees:"⋀i. Vagree ν ν' (FVDiff (args i))" using agree agree_func by metis
then have agrees':"⋀i. Vagree ν ν' (FVT (args i))"
using agrees FVDiff_sub
by (metis agree_sub)
from Iagree_Func [OF IA ]have fEq:"Functions I var = Functions J var" by auto
have subs:"⋀i.{Inl x |x. x ∈ SIGT (args i)} ⊆ {Inl x |x. x ∈ SIGT ($f var args)}"
by auto
from IA have IAs:"⋀i. Iagree I J {Inl x |x. x ∈ SIGT (args i)}"
using Iagree_sub[OF subs] by auto
have sterms:"⋀i. sterm_sem I (args i) (fst ν) = sterm_sem J (args i) (fst ν')"
subgoal for i
using frees agrees' coincidence_sterm'[of "args i" ν ν' I J] IAs
by (auto)
done
have frechets:"⋀i. frechet I (args i) (fst ν) (snd ν) = frechet J (args i) (fst ν') (snd ν')"
using IH[OF agrees IAs] agrees frees rangeI by blast
show "?case"
using agrees agrees' sterms frechets fEq by auto
next
case (dfree_Plus t1 t2)
assume dfree1:"dfree t1"
assume dfree2:"dfree t2"
assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t1} ⟹ frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t2} ⟹ frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
assume agree:"Vagree ν ν' (FVDiff (Plus t1 t2))"
assume IA:"Iagree I J {Inl x |x. x ∈ SIGT (Plus t1 t2)}"
have subs:"{Inl x |x. x ∈ SIGT t1} ⊆ {Inl x |x. x ∈ SIGT (Plus t1 t2)}" "{Inl x |x. x ∈ SIGT t2} ⊆ {Inl x |x. x ∈ SIGT (Plus t1 t2)}"
by auto
from IA
have IA1:"Iagree I J {Inl x |x. x ∈ SIGT t1}"
and IA2:"Iagree I J {Inl x |x. x ∈ SIGT t2}"
using Iagree_sub[OF subs(1)] Iagree_sub[OF subs(2)] by auto
have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_plus1 by (blast)
have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_plus2 by (blast)
have agree1':"Vagree ν ν' (FVT t1)" using agree1 primify_contains by (auto simp add: Vagree_def, metis)
have agree2':"Vagree ν ν' (FVT t2)" using agree2 primify_contains by (auto simp add: Vagree_def, metis)
have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
using IH1 agree1 IA1 by (auto)
have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
using IH2 agree2 IA2 by (auto)
show "?case"
using coincidence_sterm[OF agree1'] coincidence_sterm[OF agree1'] coincidence_sterm[OF agree2']
by (auto simp add: IH1' IH2' UnCI Vagree_def)
next
case (dfree_Times t1 t2)
assume dfree1:"dfree t1"
assume dfree2:"dfree t2"
assume IH1:"(Vagree ν ν' (FVDiff t1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t1} ⟹ frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
assume IH2:"(Vagree ν ν' (FVDiff t2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT t2} ⟹ frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
assume agree:"Vagree ν ν' (FVDiff (Times t1 t2))"
assume IA:"Iagree I J {Inl x |x. x ∈ SIGT (Times t1 t2)}"
have subs:"{Inl x |x. x ∈ SIGT t1} ⊆ {Inl x |x. x ∈ SIGT (Times t1 t2)}" "{Inl x |x. x ∈ SIGT t2} ⊆ {Inl x |x. x ∈ SIGT (Times t1 t2)}"
by auto
from IA
have IA1:"Iagree I J {Inl x |x. x ∈ SIGT t1}"
and IA2:"Iagree I J {Inl x |x. x ∈ SIGT t2}"
using Iagree_sub[OF subs(1)] Iagree_sub[OF subs(2)] by auto
have agree1:"Vagree ν ν' (FVDiff t1)" using agree agree_times1 by (blast)
then have agree1':"Vagree ν ν' (FVT t1)"
using agree1 primify_contains by (auto simp add: Vagree_def, metis)
have agree2:"Vagree ν ν' (FVDiff t2)" using agree agree_times2 by (blast)
then have agree2':"Vagree ν ν' (FVT t2)"
using agree2 primify_contains by (auto simp add: Vagree_def, metis)
have IH1':"(frechet I t1 (fst ν) (snd ν) = frechet J t1 (fst ν') (snd ν'))"
using IH1 agree1 IA1 by (auto)
have IH2':"(frechet I t2 (fst ν) (snd ν) = frechet J t2 (fst ν') (snd ν'))"
using IH2 agree2 IA2 by (auto)
note co1 = coincidence_sterm'[of "t1" ν ν' I J] and co2 = coincidence_sterm'[of "t2" ν ν' I J]
show "?case"
using co1 [OF dfree1 agree1' IA1] co2 [OF dfree2 agree2' IA2] IH1' IH2' by auto
qed
lemma coincidence_dterm:
fixes I :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c state" and ν'::"'c state"
shows "dsafe θ ⟹ Vagree ν ν' (FVT θ) ⟹ dterm_sem I θ ν = dterm_sem I θ ν'"
proof (induction rule: dsafe.induct)
case (dsafe_Fun args f)
assume safe:"(⋀i. dsafe (args i))"
assume IH:"⋀i. Vagree ν ν' (FVT (args i)) ⟹ dterm_sem I (args i) ν = dterm_sem I (args i) ν'"
assume agree:"Vagree ν ν' (FVT ($f f args))"
then have "⋀i. Vagree ν ν' (FVT (args i))"
using agree_func_fvt by (metis)
then show "?case"
using safe coincidence_sterm IH rangeI by (auto)
qed (auto simp: Vagree_def directional_derivative_def coincidence_frechet)
lemma coincidence_dterm':
fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c::finite state" and ν'::"'c::finite state"
shows "dsafe θ ⟹ Vagree ν ν' (FVT θ) ⟹ Iagree I J {Inl x | x. x ∈ (SIGT θ)} ⟹ dterm_sem I θ ν = dterm_sem J θ ν'"
proof (induction rule: dsafe.induct)
case (dsafe_Fun args f) then
have safe:"(⋀i. dsafe (args i))"
and IH:"⋀i. Vagree ν ν' (FVT (args i)) ⟹ Iagree I J {Inl x | x. x ∈ (SIGT (args i))} ⟹ dterm_sem I (args i) ν = dterm_sem J (args i) ν'"
and agree:"Vagree ν ν' (FVT ($f f args))"
and IA:"Iagree I J {Inl x |x. x ∈ SIGT ($f f args)}"
by auto
have subs:"⋀i. {Inl x |x. x ∈ SIGT (args i)} ⊆ {Inl x |x. x ∈ SIGT ($f f args)}" by auto
from IA have IAs:
"⋀i. Iagree I J {Inl x |x. x ∈ SIGT (args i)}"
using Iagree_sub [OF subs IA] by auto
from agree have agrees:"⋀i. Vagree ν ν' (FVT (args i))"
using agree_func_fvt by (metis)
from Iagree_Func [OF IA] have fEq:"Functions I f = Functions J f" by auto
then show "?case"
using safe coincidence_sterm IH[OF agrees IAs] rangeI agrees fEq
by (auto)
next
case (dsafe_Plus θ⇩1 θ⇩2) then
have safe:"dsafe θ⇩1" "dsafe θ⇩2"
and IH1:"Vagree ν ν' (FVT θ⇩1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩1} ⟹ dterm_sem I θ⇩1 ν = dterm_sem J θ⇩1 ν'"
and IH2:"Vagree ν ν' (FVT θ⇩2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩2} ⟹ dterm_sem I θ⇩2 ν = dterm_sem J θ⇩2 ν'"
and VA:"Vagree ν ν' (FVT (Plus θ⇩1 θ⇩2))"
and IA:"Iagree I J {Inl x |x. x ∈ SIGT (Plus θ⇩1 θ⇩2)}"
by auto
from VA have VA1:"Vagree ν ν' (FVT θ⇩1)" and VA2:"Vagree ν ν' (FVT θ⇩2)"
unfolding Vagree_def by auto
have subs:"{Inl x |x. x ∈ SIGT θ⇩1} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩1 θ⇩2)}"
"{Inl x |x. x ∈ SIGT θ⇩2} ⊆ {Inl x |x. x ∈ SIGT (Plus θ⇩1 θ⇩2)}"by auto
from IA have IA1:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩1}" and IA2:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩2}"
using Iagree_sub subs by auto
then show ?case
using IH1[OF VA1 IA1] IH2[OF VA2 IA2] by auto
next
case (dsafe_Times θ⇩1 θ⇩2) then
have safe:"dsafe θ⇩1" "dsafe θ⇩2"
and IH1:"Vagree ν ν' (FVT θ⇩1) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩1} ⟹ dterm_sem I θ⇩1 ν = dterm_sem J θ⇩1 ν'"
and IH2:"Vagree ν ν' (FVT θ⇩2) ⟹ Iagree I J {Inl x |x. x ∈ SIGT θ⇩2} ⟹ dterm_sem I θ⇩2 ν = dterm_sem J θ⇩2 ν'"
and VA:"Vagree ν ν' (FVT (Times θ⇩1 θ⇩2))"
and IA:"Iagree I J {Inl x |x. x ∈ SIGT (Times θ⇩1 θ⇩2)}"
by auto
from VA have VA1:"Vagree ν ν' (FVT θ⇩1)" and VA2:"Vagree ν ν' (FVT θ⇩2)"
unfolding Vagree_def by auto
have subs:"{Inl x |x. x ∈ SIGT θ⇩1} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩1 θ⇩2)}"
"{Inl x |x. x ∈ SIGT θ⇩2} ⊆ {Inl x |x. x ∈ SIGT (Times θ⇩1 θ⇩2)}"by auto
from IA have IA1:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩1}" and IA2:"Iagree I J {Inl x |x. x ∈ SIGT θ⇩2}"
using Iagree_sub subs by auto
then show ?case
using IH1[OF VA1 IA1] IH2[OF VA2 IA2] by auto
qed (auto simp: Vagree_def directional_derivative_def coincidence_frechet')
subsection ‹ODE Coincidence Theorems›
lemma coincidence_ode:
fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c::finite state" and ν'::"'c::finite state"
shows "osafe ODE ⟹
Vagree ν ν' (Inl ` FVO ODE) ⟹
Iagree I J ({Inl x | x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) | x. Inr x ∈ SIGO ODE}) ⟹
ODE_sem I ODE (fst ν) = ODE_sem J ODE (fst ν')"
proof (induction rule: osafe.induct)
case (osafe_Var c)
then show ?case
proof (auto)
assume VA:"Vagree ν ν' (range Inl)"
have eqV:"(fst ν) = (fst ν')"
using agree_UNIV_fst[OF VA] by auto
assume IA:"Iagree I J {Inr (Inr c)}"
have eqIJ:"ODEs I c = ODEs J c"
using Iagree_ODE[OF IA] by auto
show "ODEs I c (fst ν) = ODEs J c (fst ν')"
by (auto simp add: eqV eqIJ)
qed
next
case (osafe_Sing θ x)
then show ?case
proof (auto)
assume free:"dfree θ"
and VA:"Vagree ν ν' (insert (Inl x) (Inl ` {x. Inl x ∈ FVT θ}))"
and IA:"Iagree I J {Inl x |x. x ∈ SIGT θ}"
from VA have VA':"Vagree ν ν' {Inl x | x. Inl x ∈ FVT θ}" unfolding Vagree_def by auto
have agree_Lem:"⋀θ. dfree θ ⟹ Vagree ν ν' {Inl x | x. Inl x ∈ FVT θ} ⟹ Vagree ν ν' (FVT θ)"
subgoal for θ
apply(induction rule: dfree.induct)
by(auto simp add: Vagree_def)
done
have trm:"sterm_sem I θ (fst ν) = sterm_sem J θ (fst ν')"
using coincidence_sterm' free VA' IA agree_Lem[of θ, OF free] by blast
show "(λi. if i = x then sterm_sem I θ (fst ν) else 0) =
(λi. if i = x then sterm_sem J θ (fst ν') else 0)"
by (auto simp add: vec_eq_iff trm)
qed
next
case (osafe_Prod ODE1 ODE2)
then show ?case
proof (auto)
assume safe1:"osafe ODE1"
and safe2:"osafe ODE2"
and disjoint:"ODE_dom ODE1 ∩ ODE_dom ODE2 = {}"
and IH1:"Vagree ν ν' (Inl ` FVO ODE1) ⟹
Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1}) ⟹ ODE_sem I ODE1 (fst ν) = ODE_sem J ODE1 (fst ν')"
and IH2:"Vagree ν ν' (Inl ` FVO ODE2) ⟹
Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE2}) ⟹ ODE_sem I ODE2 (fst ν) = ODE_sem J ODE2 (fst ν')"
and VA:"Vagree ν ν' (Inl ` (FVO ODE1 ∪ FVO ODE2))"
and IA:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE1 ∨ Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1 ∨ Inr x ∈ SIGO ODE2})"
let ?IA = "({Inl x |x. Inl x ∈ SIGO ODE1 ∨ Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1 ∨ Inr x ∈ SIGO ODE2})"
have FVsubs:
"Inl ` FVO ODE2 ⊆ Inl ` (FVO ODE1 ∪ FVO ODE2)"
"Inl ` FVO ODE1 ⊆ Inl ` (FVO ODE1 ∪ FVO ODE2)"
by auto
from VA
have VA1:"Vagree ν ν' (Inl ` FVO ODE1)"
and VA2:"Vagree ν ν' (Inl ` FVO ODE2)"
using agree_sub[OF FVsubs(1)] agree_sub[OF FVsubs(2)]
by (auto)
have SIGsubs:
"({Inl x |x. Inl x ∈ SIGO ODE1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1}) ⊆ ?IA"
"({Inl x |x. Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE2}) ⊆ ?IA"
by auto
from IA
have IA1:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE1})"
and IA2:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE2} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE2})"
using Iagree_sub[OF SIGsubs(1)] Iagree_sub[OF SIGsubs(2)] by auto
show "ODE_sem I ODE1 (fst ν) + ODE_sem I ODE2 (fst ν) = ODE_sem J ODE1 (fst ν') + ODE_sem J ODE2 (fst ν')"
using IH1[OF VA1 IA1] IH2[OF VA2 IA2] by auto
qed
qed
lemma coincidence_ode':
fixes I J :: "('a::finite, 'b::finite, 'c::finite) interp" and ν :: "'c simple_state" and ν'::"'c simple_state"
shows "osafe ODE ⟹
VSagree ν ν' (FVO ODE) ⟹
Iagree I J ({Inl x | x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) | x. Inr x ∈ SIGO ODE}) ⟹
ODE_sem I ODE ν = ODE_sem J ODE ν'"
using coincidence_ode[of ODE "(ν, χ i. 0)" "(ν', χ i. 0)" I J]
apply(auto)
unfolding VSagree_def Vagree_def apply auto
done
lemma alt_sem_lemma:"⋀ I::('a::finite,'b::finite,'c::finite) interp. ⋀ ODE::('a::finite,'c::finite) ODE. ⋀sol. ⋀t::real. ⋀ ab. osafe ODE ⟹
ODE_sem I ODE (sol t) = ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"
proof -
fix I::"('a,'b,'c) interp"
and ODE::"('a,'c) ODE"
and sol
and t::real
and ab
assume safe:"osafe ODE"
have VA:"VSagree (sol t) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i) (FVO ODE)"
unfolding VSagree_def Vagree_def by auto
have IA: "Iagree I I ({Inl x | x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) | x. Inr x ∈ SIGO ODE})" unfolding Iagree_def by auto
show "ODE_sem I ODE (sol t) = ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"
using coincidence_ode'[OF safe VA IA] by auto
qed
lemma bvo_to_fvo:"Inl x ∈ BVO ODE ⟹ x ∈ FVO ODE"
proof (induction ODE)
qed auto
lemma ode_to_fvo:"x ∈ ODE_vars I ODE ⟹ x ∈ FVO ODE"
proof (induction ODE)
qed auto
definition coincide_hp :: "('a::finite, 'b::finite, 'c::finite) hp ⇒ ('a::finite, 'b::finite, 'c::finite) interp ⇒ ('a::finite, 'b::finite, 'c::finite) interp ⇒ bool"
where "coincide_hp α I J ⟷ (∀ ν ν' μ V. Iagree I J (SIGP α) ⟶ Vagree ν ν' V ⟶ V ⊇ (FVP α) ⟶ (ν, μ) ∈ prog_sem I α ⟶ (∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V)))"
definition ode_sem_equiv ::"('a::finite, 'b::finite, 'c::finite) hp ⇒ ('a::finite, 'b::finite, 'c::finite) interp ⇒ bool"
where "ode_sem_equiv α I ⟷
(∀ODE::('a::finite,'c::finite) ODE. ∀φ::('a::finite,'b::finite,'c::finite)formula. osafe ODE ⟶ fsafe φ ⟶
(α = EvolveODE ODE φ) ⟶
{(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE φ)}} =
{(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
sol 0 = fst ν})"
definition coincide_hp' :: "('a::finite, 'b::finite, 'c::finite) hp ⇒ bool"
where "coincide_hp' α ⟷ (∀ I J. coincide_hp α I J ∧ ode_sem_equiv α I)"
definition coincide_fml :: "('a::finite, 'b::finite, 'c::finite) formula ⇒ bool"
where "coincide_fml φ ⟷ (∀ ν ν' I J . Iagree I J (SIGF φ) ⟶ Vagree ν ν' (FVF φ) ⟶ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"
lemma coinc_fml [simp]: "coincide_fml φ = (∀ ν ν' I J. Iagree I J (SIGF φ) ⟶ Vagree ν ν' (FVF φ) ⟶ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"
unfolding coincide_fml_def by auto
subsection ‹Coincidence Theorems for Programs and Formulas›
lemma coincidence_hp_fml:
fixes α::"('a::finite, 'b::finite, 'c::finite) hp"
fixes φ::"('a::finite, 'b::finite, 'c::finite) formula"
shows "(hpsafe α ⟶ coincide_hp' α) ∧ (fsafe φ ⟶ coincide_fml φ)"
proof (induction rule: hpsafe_fsafe.induct)
case (hpsafe_Pvar x)
thus "?case"
apply(unfold coincide_hp'_def | rule allI | rule conjI)+
prefer 2 unfolding ode_sem_equiv_def subgoal by auto
unfolding coincide_hp_def apply(auto)
subgoal for I J a b aa ba ab bb V
proof -
assume IA:"Iagree I J {Inr (Inr x)}"
have Peq:"⋀y. y ∈ Programs I x ⟷ y ∈ Programs J x" using Iagree_Prog[OF IA] by auto
assume agree:"Vagree (a, b) (aa, ba) V"
and sub:"UNIV ⊆ V"
and sem:"((a, b), ab, bb) ∈ Programs I x"
from agree_UNIV_eq[OF agree_sub [OF sub agree]]
have eq:"(a,b) = (aa,ba)" by auto
hence sem':"((aa,ba), (ab,bb)) ∈ Programs I x"
using sem by auto
have triv_sub:"V ⊆ UNIV" by auto
have VA:"Vagree (ab,bb) (ab,bb) V" using agree_sub[OF triv_sub agree_refl[of "(ab,bb)"]] eq
by auto
show "∃a b. ((aa, ba), a, b) ∈ Programs J x ∧ Vagree (ab, bb) (a, b) V"
apply(rule exI[where x="ab"])
apply(rule exI[where x="bb"])
using sem eq VA by (auto simp add: Peq)
qed
done
next
case (hpsafe_Assign e x) then
show "?case"
proof (auto simp only: coincide_hp'_def ode_sem_equiv_def coincide_hp_def)
fix I J :: "('a::finite,'b::finite,'c::finite) interp"
and ν1 ν2 ν'1 ν'2 μ1 μ2 V
assume safe:"dsafe e"
and IA:"Iagree I J (SIGP (x := e))"
and VA:"Vagree (ν1, ν2) (ν'1, ν'2) V"
and sub:"FVP (x := e) ⊆ V"
and sem:"((ν1, ν2), (μ1, μ2)) ∈ prog_sem I (x := e)"
from VA have VA':"Vagree (ν1, ν2) (ν'1, ν'2) (FVT e)" unfolding FVP.simps Vagree_def using sub by auto
have Ssub:"{Inl x | x. x ∈ SIGT e} ⊆ (SIGP (x := e))" by auto
from IA have IA':"Iagree I J {Inl x | x. x ∈ SIGT e}" using Ssub unfolding SIGP.simps by auto
have "((ν1, ν2), repv (ν1, ν2) x (dterm_sem I e (ν1, ν2))) ∈ prog_sem I (x := e)" by auto
then have sem':"((ν'1, ν'2), repv (ν'1, ν'2) x (dterm_sem J e (ν'1, ν'2))) ∈ prog_sem J (x := e)"
using coincidence_dterm' safe VA' IA' by auto
from sem have eq:"(μ1, μ2) = (repv (ν1, ν2) x (dterm_sem I e (ν1, ν2)))" by auto
have VA'':"Vagree (μ1, μ2) (repv (ν'1, ν'2) x (dterm_sem J e (ν'1, ν'2))) (MBV (x := e) ∪ V)"
using coincidence_dterm'[of e "(ν1,ν2)" "(ν'1,ν'2)" I J] safe VA' IA' eq agree_refl VA unfolding MBV.simps Vagree_def
by auto
show "∃μ'. ((ν'1, ν'2), μ') ∈ prog_sem J (x := e) ∧ Vagree (μ1, μ2) μ' (MBV (x := e) ∪ V)"
using VA'' sem' by blast
qed
next
case (hpsafe_DiffAssign e x) then show "?case"
proof (auto simp only: coincide_hp'_def ode_sem_equiv_def coincide_hp_def)
fix I J::"('a,'b,'c) interp"
and ν ν' μ V
assume safe:"dsafe e"
and IA:"Iagree I J (SIGP (DiffAssign x e))"
and VA:"Vagree ν ν' V"
and sub:"FVP (DiffAssign x e) ⊆ V"
and sem:"(ν, μ) ∈ prog_sem I (DiffAssign x e)"
from VA have VA':"Vagree ν ν' (FVT e)" unfolding FVP.simps Vagree_def using sub by auto
have Ssub:"{Inl x | x. x ∈ SIGT e} ⊆ (SIGP (DiffAssign x e))" by auto
from IA have IA':"Iagree I J {Inl x | x. x ∈ SIGT e}" using Ssub unfolding SIGP.simps by auto
have "(ν, repv ν x (dterm_sem I e ν)) ∈ prog_sem I (x := e)" by auto
then have sem':"(ν', repd ν' x (dterm_sem J e ν')) ∈ prog_sem J (DiffAssign x e)"
using coincidence_dterm' safe VA' IA' by auto
from sem have eq:"μ = (repd ν x (dterm_sem I e ν))" by auto
have VA':"Vagree μ (repd ν' x (dterm_sem J e ν')) (MBV (DiffAssign x e) ∪ V)"
using coincidence_dterm'[OF safe VA', of I J, OF IA'] eq agree_refl VA unfolding MBV.simps Vagree_def
by auto
show "∃μ'. (ν', μ') ∈ prog_sem J (DiffAssign x e) ∧ Vagree μ μ' (MBV (DiffAssign x e) ∪ V)"
using VA' sem' by blast
qed
next
case (hpsafe_Test P) then
show "?case"
proof (auto simp add:coincide_hp'_def ode_sem_equiv_def coincide_hp_def)
fix I J::"('a,'b,'c) interp" and ν ν' ω ω' ::"'c simple_state"
and V
assume safe:"fsafe P"
assume "∀a b aa ba I J. (Iagree I J (SIGF P) ⟶ Vagree (a, b) (aa, ba) (FVF P) ⟶ ((a, b) ∈ fml_sem I P) = ((aa, ba) ∈ fml_sem J P))"
hence IH:"Iagree I J (SIGF P) ⟹ Vagree (ν, ν') (ω, ω') (FVF P) ⟹ ((ν, ν') ∈ fml_sem I P) = ((ω, ω') ∈ fml_sem J P)"
by auto
assume IA:"Iagree I J (SIGF P)"
assume VA:"Vagree (ν, ν') (ω, ω') V"
assume sub:"FVF P ⊆ V"
hence VA':"Vagree (ν, ν') (ω, ω') (FVF P)" using agree_supset VA by auto
assume sem:"(ν, ν') ∈ fml_sem I P"
show "(ω, ω') ∈ fml_sem J P" using IH[OF IA VA'] sem by auto
qed
next
case (hpsafe_Evolve ODE P) then show "?case"
proof (unfold coincide_hp'_def)
assume osafe:"osafe ODE"
assume fsafe:"fsafe P"
assume IH:"coincide_fml P"
from IH have IHF:"⋀ν ν' I J. Iagree I J (SIGF P) ⟹ Vagree ν ν' (FVF P) ⟹ (ν ∈ fml_sem I P) = (ν' ∈ fml_sem J P)"
unfolding coincide_fml_def by auto
have equiv:"⋀I. ode_sem_equiv (EvolveODE ODE P) I"
subgoal for I
apply(unfold ode_sem_equiv_def)
apply(rule allI)+
subgoal for ODE φ
apply(rule impI)+
apply(auto)
subgoal for aa ba ab bb sol t
apply(rule exI[where x="(λt. χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"])
apply(rule conjI)
subgoal using mk_v_agree[of I ODE "(ab,bb)" "sol t"] mk_v_agree[of I ODE "(ab,bb)" "(χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"]
unfolding Vagree_def VSagree_def by (auto simp add: vec_eq_iff)
apply(rule exI[where x=t])
apply(rule conjI)
subgoal
apply(rule agree_UNIV_eq)
using mk_v_agree[of I ODE "(ab,bb)" "sol t"]
mk_v_agree[of I ODE "(ab,bb)" "(χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"]
mk_v_agree[of I ODE "(χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb)" "(χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)"]
unfolding Vagree_def VSagree_def
apply(auto)
subgoal for i
apply(cases "Inl i ∈ BVO ODE")
using bvo_to_fvo[of i ODE] apply (metis (no_types, lifting))
apply(erule allE[where x=i])+
using Inl_Inr_False imageE ode_to_fvo
proof -
assume a1: "(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
assume a2: "(Inl i ∈ BVO ODE ⟶ sol 0 $ i = ab $ i) ∧ ( Inl i ∈ Inl ` FVO ODE ⟶ sol 0 $ i = ab $ i) ∧ (Inl i ∈ FVF φ ⟶ sol 0 $ i = ab $ i)"
assume a3: "(Inl i::'c + 'c) ∉ Inl ` ODE_vars I ODE ∧ Inl i ∉ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (ab, bb) (sol t)) $ i = ab $ i"
assume a4: "(Inl i::'c + 'c) ∉ Inl ` ODE_vars I ODE ∧ Inl i ∉ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = (if i ∈ FVO ODE then sol 0 $ i else ab $ i)"
assume a5: "((Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ⟶ fst (mk_v I ODE (ab, bb) (sol t)) $ i = sol t $ i) ∧ (Inl i ∈ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (ab, bb) (sol t)) $ i = sol t $ i)"
assume a6: "((Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ⟶ fst (mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = (if i ∈ FVO ODE then sol t $ i else ab $ i)) ∧ (Inl i ∈ Inr ` ODE_vars I ODE ⟶ fst (mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = (if i ∈ FVO ODE then sol t $ i else ab $ i))"
have f7: "fst (aa, ba) $ i = sol t $ i ∨ (Inl i::'c + 'c) ∉ Inl ` ODE_vars I ODE"
using a5 a1 by auto
have f8: "fst (aa, ba) $ i = ab $ i ∨ (Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE"
using a3 a1 by fastforce
moreover
{ assume "fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ ab $ i"
{ assume "fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ ab $ i ∧ Inl i ∉ Inr ` ODE_vars I ODE"
have " i ∈ FVO ODE ∧ fst (aa, ba) $ i = ab $ i ⟶ fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ sol t $ i ∧ (Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ∨ fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = ab $ i"
using f7 a4 a2 by force }
then have " i ∈ FVO ODE ∧ fst (aa, ba) $ i = ab $ i ⟶ fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i ≠ sol t $ i ∧ (Inl i::'c + 'c) ∈ Inl ` ODE_vars I ODE ∨ fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = ab $ i"
by blast }
ultimately have " i ∈ FVO ODE ⟶ fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = fst (aa, ba) $ i"
using f7 a6 by fastforce
then have "fst (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = fst (aa, ba) $ i"
using f8 a4 ode_to_fvo by fastforce
then show ?thesis
using a1 by presburger
qed
proof -
fix i :: 'c
assume a1: "osafe ODE"
assume a2: "(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
assume a3: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i) $ i)"
assume a4: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol t)) $ i = ODE_sem I ODE (sol t) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol t)) $ i = ODE_sem I ODE (sol t) $ i)"
assume a5: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if i ∈ FVO ODE then sol t $ i else ab $ i)) $ i = bb $ i"
assume a6: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol t)) $ i = bb $ i"
have "⋀i f r v. ODE_sem (i::('a, 'b, 'c) interp) ODE (χ c. if c ∈ FVO ODE then f (r::real) $ c else v $ c) = ODE_sem i ODE (f r)"
using a1 by (metis (no_types) alt_sem_lemma)
moreover
{ assume "(Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE"
moreover
{ assume "(Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∧ Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∧ Inr i ∉ Inl ` ODE_vars I ODE"
then have "snd (aa, ba) $ i = bb $ i ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∧ Inr i ∉ Inl ` ODE_vars I ODE"
using a6 a2 by presburger
then have "snd (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = snd (aa, ba) $ i"
using a5 by presburger }
ultimately have "snd (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i = snd (aa, ba) $ i"
by blast }
ultimately show "snd (mk_v I ODE (ab, bb) (sol t)) $ i = snd (mk_v I ODE (χ c. if c ∈ FVO ODE then sol 0 $ c else ab $ c, bb) (χ c. if c ∈ FVO ODE then sol t $ c else ab $ c)) $ i"
using a4 a3 a2 by fastforce
qed
apply(rule conjI)
subgoal by auto
apply(auto simp only: solves_ode_def has_vderiv_on_def has_vector_derivative_def)
apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
defer
apply (rule ext)
apply (subst scaleR_vec_def)
apply (rule refl)
subgoal for x unfolding VSagree_def apply auto
proof -
assume osafe:"osafe ODE"
and fsafe:"fsafe φ"
and eqP:"P = φ"
and aaba: "(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
and all:"∀i. (Inl i ∈ BVO ODE ⟶ sol 0 $ i = ab $ i) ∧ (Inl i ∈ Inl ` FVO ODE ⟶ sol 0 $ i = ab $ i) ∧ (Inl i ∈ FVF φ ⟶ sol 0 $ i = ab $ i)"
and allSol:"∀x∈{0..t}. (sol has_derivative (λxa. xa *⇩R ODE_sem I ODE (sol x))) (at x within {0..t})"
and mkV:"sol ∈ {0..t} → {x. mk_v I ODE (ab, bb) x ∈ fml_sem I φ}"
and x:"0 ≤ x"
and t:"x ≤ t"
from all have allT:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ mk_v I ODE (ab,bb) (sol s) ∈ fml_sem I φ"
using mkV by auto
have VA:"⋀x. Vagree (mk_v I ODE (ab, bb) (sol x)) (mk_v I ODE (ab, bb) (χ i. if i ∈ FVO ODE then sol x $ i else ab $ i))
(FVF φ)"
unfolding Vagree_def
apply(auto)
subgoal for xa i
using mk_v_agree[of I ODE "(ab,bb)" "sol xa"]
mk_v_agree[of I ODE "(ab,bb)" "(χ i. if i ∈ FVO ODE then sol xa $ i else ab $ i)"]
apply(cases "i ∈ ODE_vars I ODE")
using ode_to_fvo [of i I ODE] unfolding Vagree_def
apply auto
by fastforce
subgoal for xa i
using mk_v_agree[of I ODE "(ab,bb)" "sol xa"]
mk_v_agree[of I ODE "(ab,bb)" "(χ i. if i ∈ FVO ODE then sol xa $ i else ab $ i)"]
ODE_vars_lr
using ode_to_fvo[of i I ODE] unfolding Vagree_def apply auto
using alt_sem_lemma osafe
subgoal
proof -
assume a1: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = bb $ i"
assume a2: "∀i. Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (χ i. if i ∈ FVO ODE then sol xa $ i else ab $ i)) $ i = bb $ i"
assume a3: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = ODE_sem I ODE (sol xa) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = ODE_sem I ODE (sol xa) $ i)"
assume a4: "∀i. (Inr i ∈ Inl ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (χ i. if i ∈ FVO ODE then sol xa $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol xa $ i else ab $ i) $ i) ∧ ((Inr i::'c + 'c) ∈ Inr ` ODE_vars I ODE ⟶ snd (mk_v I ODE (ab, bb) (χ i. if i ∈ FVO ODE then sol xa $ i else ab $ i)) $ i = ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol xa $ i else ab $ i) $ i)"
have "ODE_sem I ODE (χ c. if c ∈ FVO ODE then sol xa $ c else ab $ c) $ i = ODE_sem I ODE (sol xa) $ i"
by (metis (no_types) alt_sem_lemma osafe)
then have "Inr i ∉ Inl ` ODE_vars I ODE ∧ (Inr i::'c + 'c) ∉ Inr ` ODE_vars I ODE ∨ snd (mk_v I ODE (ab, bb) (sol xa)) $ i = snd (mk_v I ODE (ab, bb) (χ c. if c ∈ FVO ODE then sol xa $ c else ab $ c)) $ i"
using a4 a3 by fastforce
then show ?thesis
using a2 a1 by presburger
qed
done
done
note sem = IHF[OF Iagree_refl[of I]]
have VA1:"(∀i. Inl i ∈ FVF φ ⟶
fst (mk_v I ODE ((χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i), bb) (χ i. if i ∈ FVO ODE then sol x $ i else ab $ i)) $ i
= fst (mk_v I ODE (ab, bb) (sol x)) $ i)"
and VA2: "(∀i. Inr i ∈ FVF φ ⟶
snd (mk_v I ODE ((χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i), bb) (χ i. if i ∈ FVO ODE then sol x $ i else ab $ i)) $ i
= snd (mk_v I ODE (ab, bb) (sol x)) $ i)"
apply(auto)
subgoal for i
using mk_v_agree[of I ODE "((χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i),bb)" "(χ i. if i ∈ FVO ODE then sol x $ i else ab $ i)"]
using mk_v_agree[of I ODE "(ab,bb)" "(sol x)"] ODE_vars_lr[of i I ODE]
unfolding Vagree_def apply (auto)
apply(erule allE[where x=i])+
apply(cases " i ∈ FVO ODE")
apply(auto)
apply(cases " i ∈ FVO ODE")
apply(auto)
using ODE_vars_lr[of i I ODE] ode_to_fvo[of i I ODE]
apply auto
using all by meson
subgoal for i
using mk_v_agree[of I ODE "((χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i),bb)" "(χ i. if i ∈ FVO ODE then sol x $ i else ab $ i)"]
using mk_v_agree[of I ODE "(ab,bb)" "(sol x)"] ODE_vars_lr[of i I ODE]
unfolding Vagree_def apply (auto)
apply(erule allE[where x=i])+
apply(cases " i ∈ FVO ODE")
apply(auto)
apply(cases " i ∈ FVO ODE")
apply(auto)
using ODE_vars_lr[of i I ODE] ode_to_fvo[of i I ODE]
apply(auto)
using alt_sem_lemma osafe
by (metis (no_types) alt_sem_lemma osafe)+
done
show "mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb)
(χ i. if i ∈ FVO ODE then sol x $ i else ab $ i) ∈ fml_sem I φ"
using mk_v_agree[of I ODE "(χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb)"
"(χ i. if i ∈ FVO ODE then sol x $ i else ab $ i)"]
mk_v_agree[of I ODE "(ab, bb)" "sol x"]
using sem[of "mk_v I ODE (χ i. if i ∈ FVO ODE then sol 0 $ i else ab $ i, bb) (χ i. if i ∈ FVO ODE then sol x $ i else ab $ i)"
"mk_v I ODE (ab, bb) (sol x)"]
VA1 VA2
allT[of x] allT[of 0]
unfolding Vagree_def
apply auto
using atLeastAtMost_iff mem_Collect_eq mkV t x
apply(auto)
using eqP VA sem
by auto
qed
proof -
fix x i
assume
assms:"osafe ODE"
"fsafe φ"
"0 ≤ t"
"(aa, ba) = mk_v I ODE (ab, bb) (sol t)"
"VSagree (sol 0) ab {x. Inl x ∈ BVO ODE ∨ Inl x ∈ Inl ` FVO ODE ∨ Inl x ∈ FVF φ}"
and deriv:"∀x∈{0..t}. (sol has_derivative (λxa. xa *⇩R ODE_sem I ODE (sol x))) (at x within {0..t})"
and sol:"sol ∈ {0..t} → {x. mk_v I ODE (ab, bb) x ∈ fml_sem I φ}"
and mem:"x ∈ {0..t}"
from deriv
have xDeriv:"(sol has_derivative (λxa. xa *⇩R ODE_sem I ODE (sol x))) (at x within {0..t})"
using mem by blast
have silly1:"(λx. χ i. sol x $ i) = sol"
by (auto simp add: vec_eq_iff)
have silly2:"(λh. χ i. h * ODE_sem I ODE (sol x) $ i) = (λxa. xa *⇩R ODE_sem I ODE (sol x))"
by (auto simp add: vec_eq_iff)
from xDeriv have
xDeriv':"((λx. χ i. sol x $ i) has_derivative (λh. χ i. h * ODE_sem I ODE (sol x) $ i)) (at x within {0..t})"
using silly1 silly2 apply auto done
from xDeriv have xDerivs:"⋀j. ((λt. sol t $ j) has_derivative (λxa. (xa *⇩R ODE_sem I ODE (sol x)) $ j)) (at x within {0..t})"
subgoal for j
using silly1 silly2 has_derivative_proj[of "(λi. λt. sol t $ i)" "(λ i. λxa. (xa *⇩R ODE_sem I ODE (sol x)) $ i)" "(at x within {0..t})" j]
apply auto
done
done
have neato:"⋀ν. i ∉ FVO ODE ⟹ ODE_sem I ODE ν $ i = 0"
proof (induction "ODE")
qed auto
show "((λt. if i ∈ FVO ODE then sol t $ i else ab $ i) has_derivative
(λh. h *⇩R ODE_sem I ODE (χ i. if i ∈ FVO ODE then sol x $ i else ab $ i) $ i))
(at x within {0..t})"
using assms sol mem
apply auto
apply (rule has_derivative_eq_rhs)
unfolding VSagree_def apply auto
apply(cases " i ∈ FVO ODE")
using xDerivs[of i] apply auto
using alt_sem_lemma neato[of "(χ i. if i ∈ FVO ODE then sol x $ i else ab $ i)"] apply auto
proof -
assume a1: "((λt. sol t $ i) has_derivative (λxa. xa * ODE_sem I ODE (sol x) $ i)) (at x within {0..t})"
have "⋀i r. ODE_sem (i::('a, 'b, 'c) interp) ODE (χ c. if c ∈ FVO ODE then sol r $ c else ab $ c) = ODE_sem i ODE (sol r)"
by (metis (no_types) alt_sem_lemma assms(1))
then show "((λr. sol r $ i) has_derivative (λr. r * ODE_sem I ODE (χ c. if c ∈ FVO ODE then sol x $ c else ab $ c) $ i)) (at x within {0..t})"
using a1 by presburger
qed
qed
proof -
fix aa ba bb sol t
assume osafe:"osafe ODE"
and fsafe:"fsafe φ"
and t:"0 ≤ t"
and aaba:"(aa, ba) = mk_v I ODE (sol 0, bb) (sol t)"
and sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, bb) x ∈ fml_sem I φ}"
show"∃sola ta. mk_v I ODE (sol 0, bb) (sol t) = mk_v I ODE (sol 0, bb) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODE_sem I ODE)) {0..ta} {x. mk_v I ODE (sol 0, bb) x ∈ fml_sem I φ} ∧
VSagree (sola 0) (sol 0) {x. Inl x ∈ BVO ODE ∨ Inl x ∈ Inl ` FVO ODE ∨ Inl x ∈ FVF φ}"
apply(rule exI[where x=sol])
apply(rule exI[where x=t])
using fsafe t aaba sol apply auto
unfolding VSagree_def by auto
qed
done
done
show "∀I J. coincide_hp (EvolveODE ODE P) I J ∧ ode_sem_equiv (EvolveODE ODE P) I"
proof (rule allI)+
fix I J::"('a,'b,'c) interp"
from equiv[of I]
have equivI:"
{(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I P} ∧
VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}} =
{(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I P} ∧
(sol 0) = (fst ν)}"
unfolding ode_sem_equiv_def using osafe fsafe by blast
from equiv[of J]
have equivJ:"
{(ν, mk_v J ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE ν x ∈ fml_sem J P} ∧
VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}} =
{(ν, mk_v J ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE ν x ∈ fml_sem J P} ∧
(sol 0) = (fst ν)}"
unfolding ode_sem_equiv_def using osafe fsafe by blast
from equivI
have alt_ode_semI:"prog_sem I (EvolveODE ODE P) =
{(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I P} ∧
VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}}" by auto
from equivJ
have alt_ode_semJ:"prog_sem J (EvolveODE ODE P) =
{(ν, mk_v J ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE ν x ∈ fml_sem J P} ∧
VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE P)}}" by auto
have co_hp:"coincide_hp (EvolveODE ODE P) I J"
apply(unfold coincide_hp_def)
apply (auto simp del: prog_sem.simps(8) simp add: alt_ode_semI alt_ode_semJ)
proof -
fix a b aa ba ab bb V sol t
from IH have IHF:"∀a b aa ba . Iagree I J (SIGF P) ⟶ Vagree (a, b) (aa, ba) (FVF P) ⟶ ((a, b) ∈ fml_sem I P) = ((aa, ba) ∈ fml_sem J P)"
unfolding coincide_fml_def by blast
assume IA:"Iagree I J (SIGF P ∪ {Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
and VA:"Vagree (a, b) (aa, ba) V"
and OVsub:"BVO ODE ⊆ V"
and Osub:"Inl ` FVO ODE ⊆ V"
and Fsub:"FVF P ⊆ V"
and veq:"(ab, bb) = mk_v I ODE (a, b) (sol t)"
and t:"0 ≤ t"
and sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (a, b) x ∈ fml_sem I P}"
and VSA:"VSagree (sol 0) a {uu. Inl uu ∈ BVO ODE ∨ Inl uu ∈ Inl ` FVO ODE ∨ Inl uu ∈ FVF P}"
have semBVsub:"(semBV I ODE) ⊆ BVO ODE"
by (induction ODE, auto)
then have OVsub'':"(semBV I ODE) ⊆ V" using OVsub by auto
have MBVBVsub:"(Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE) ⊆ BVO ODE"
apply(induction ODE)
by auto
from OVsub and MBVBVsub have OVsub':"(Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE) ⊆ V"
by auto
from sol
have solSem:"⋀x. 0 ≤ x ⟹ x ≤ t ⟹ mk_v I ODE (a, b) (sol x) ∈ fml_sem I P"
and solDeriv:"⋀x. 0 ≤ x ⟹ x ≤ t ⟹ (sol has_vector_derivative ODE_sem I ODE (sol x)) (at x within {0..t})"
unfolding solves_ode_def has_vderiv_on_def by auto
have SIGFsub:"(SIGF P) ⊆ (SIGF P ∪ {Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})" by auto
from IA have IAP:"Iagree I J (SIGF P)"
using Iagree_sub[OF SIGFsub] by auto
from IHF have IH':
"∀a b aa ba. Vagree (a, b) (aa, ba) (FVF P) ⟶ ((a, b) ∈ fml_sem I P) = ((aa, ba) ∈ fml_sem J P)"
using IAP by blast
from VA
have VAOV:"Vagree (a,b) (aa,ba) (BVO ODE)"
using agree_sub[OF OVsub] by auto
have ag:"⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (a, b) (- semBV I ODE)"
"⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (mk_xode I ODE (sol s)) (semBV I ODE)"
"⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (aa, ba) (- semBV J ODE)"
"⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (mk_xode J ODE (sol s)) (semBV J ODE)"
subgoal for s using mk_v_agree[of I ODE "(a,b)" "sol s"] by auto
subgoal for s using mk_v_agree[of I ODE "(a,b)" "sol s"] by auto
subgoal for s using mk_v_agree[of J ODE "(aa,ba)" "sol s"] by auto
subgoal for s using mk_v_agree[of J ODE "(aa,ba)" "sol s"] by auto
done
have sem_sub_BVO:"⋀I. semBV I ODE ⊆ BVO ODE"
subgoal for I
apply(induction ODE)
by auto
done
have MBV_sub_sem:"⋀I. (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE) ⊆ semBV I ODE"
subgoal for I by (induction ODE, auto) done
have ag_BVO:
"⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (a, b) (- BVO ODE)"
"⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (aa, ba) (- BVO ODE)"
using ag(1) ag(3) sem_sub_BVO[of I] sem_sub_BVO[of J] agree_sub by blast+
have ag_semBV:
"⋀s. Vagree (mk_v I ODE (a, b) (sol s)) (mk_xode I ODE (sol s)) (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE)"
"⋀s. Vagree (mk_v J ODE (aa, ba) (sol s)) (mk_xode J ODE (sol s)) (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE)"
using ag(2) ag(4) MBV_sub_sem[of I] MBV_sub_sem[of J]
by (simp add: agree_sub)+
have IOsub:"({Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE}) ⊆ (SIGF P ∪ {Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
by auto
from IA
have IAO:"Iagree I J ({Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
using Iagree_sub[OF IOsub] by auto
have IOsub':"({Inr (Inr x) |x. Inr x ∈ SIGO ODE}) ⊆ ({Inl x |x. Inl x ∈ SIGO ODE} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
by auto
from IAO
have IAO':"Iagree I J ({Inr (Inr x) |x. Inr x ∈ SIGO ODE})"
using Iagree_sub[OF IOsub'] by auto
have VAsol:"⋀s ν'. Vagree ((sol s), ν') ((sol s), ν') (Inl `FVO ODE)" unfolding Vagree_def by auto
have Osem:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ ODE_sem I ODE (sol s) = ODE_sem J ODE (sol s)"
subgoal for s
using coincidence_ode[OF osafe VAsol[of s] IAO] by auto
done
from Osem
have Oag:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ VSagree (ODE_sem I ODE (sol s)) (ODE_sem J ODE (sol s)) {x. Inr x ∈ BVO ODE}"
unfolding VSagree_def by auto
from Osem
have Oagsem:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ VSagree (ODE_sem I ODE (sol s)) (ODE_sem J ODE (sol s)) {x. Inr x ∈ (semBV I ODE)}"
unfolding VSagree_def by auto
from Osem
have halp:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_xode I ODE (sol s)) (mk_xode J ODE (sol s)) (semBV I ODE)"
apply(auto)
using Oag unfolding Vagree_def VSagree_def by blast
then have halpp:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (sol s, ODE_sem I ODE (sol s)) (sol s, ODE_sem J ODE (sol s)) (semBV I ODE)"
by auto
have eqV:"V = ((semBV I ODE)) ∪ (V ∩ (-(semBV I ODE)))" using OVsub'' by auto
have neat:"⋀ODE. Iagree I J ({Inr (Inr x) |x. Inr x ∈ SIGO ODE}) ⟹ semBV I ODE = semBV J ODE"
subgoal for ODE
proof (induction ODE)
case (OVar x)
then show ?case unfolding Iagree_def by auto
next
case (OSing x1a x2)
then show ?case by auto
next
case (OProd ODE1 ODE2)
assume IH1:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ODE1} ⟹ semBV I ODE1 = semBV J ODE1"
assume IH2:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ODE2} ⟹ semBV I ODE2 = semBV J ODE2"
assume agree:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO (OProd ODE1 ODE2)}"
from agree have agree1:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ( ODE1 )}" and agree2:"Iagree I J {Inr (Inr x) |x. Inr x ∈ SIGO ( ODE2)}"
unfolding Iagree_def by auto
show ?case using IH1[OF agree1] IH2[OF agree2] by auto
qed
done
note semBVeq = neat[OF IAO']
then have halpp':"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) (semBV I ODE)"
subgoal for s using ag[of s] ag_semBV[of s] Oagsem agree_trans semBVeq
unfolding Vagree_def by (auto simp add: semBVeq Osem)
done
have VAbar:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) (V ∩ (-(semBV I ODE)))"
subgoal for s
apply(unfold Vagree_def)
apply(rule conjI | rule allI)+
subgoal for i
apply auto
using VA ag[of s] semBVeq unfolding Vagree_def apply auto
by (metis Un_iff)
apply(rule allI)+
subgoal for i
using VA ag[of s] semBVeq unfolding Vagree_def by auto
done
done
have VAfoo:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) V"
using agree_union[OF halpp' VAbar] eqV by auto
have duhSub:"FVF P ⊆ UNIV" by auto
from VAfoo
have VA'foo:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) V"
using agree_sub[OF duhSub] by auto
then have VA''foo:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ Vagree (mk_v I ODE (a, b) (sol s)) (mk_v J ODE (aa, ba) (sol s)) (FVF P)"
using agree_sub[OF Fsub] by auto
from VA''foo IH'
have fmlSem:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ (mk_v I ODE (a, b) (sol s)) ∈ fml_sem I P ⟷ (mk_v J ODE (aa, ba) (sol s)) ∈ fml_sem J P"
using IAP coincide_fml_def hpsafe_Evolve.IH by blast
from VA
have VAO:"Vagree (a, b) (aa, ba) (Inl `FVO ODE)"
using agree_sub[OF Osub] by auto
have sol':"(sol solves_ode (λ_. ODE_sem J ODE)) {0..t} {x. mk_v J ODE (aa, ba) x ∈ fml_sem J P}"
apply(auto simp add: solves_ode_def has_vderiv_on_def)
subgoal for s
using solDeriv[of s] Osem[of s] by auto
subgoal for s
using solSem[of s] fmlSem[of s] by auto
done
have VSA':"VSagree (sol 0) aa {uu. Inl uu ∈ BVO ODE ∨ Inl uu ∈ Inl `FVO ODE ∨ Inl uu ∈ FVF P}"
using VSA VA OVsub unfolding VSagree_def Vagree_def
apply auto
using Osub apply blast
using Fsub by blast
show
" ∃ab bb. (∃sol t. (ab, bb) = mk_v J ODE (aa, ba) (sol t) ∧
0 ≤ t ∧
(sol solves_ode (λa. ODE_sem J ODE)) {0..t} {x. mk_v J ODE (aa, ba) x ∈ fml_sem J P} ∧
VSagree (sol 0) aa {uu. Inl uu ∈ BVO ODE ∨ Inl uu ∈ Inl `FVO ODE ∨ Inl uu ∈ FVF P}) ∧
Vagree (mk_v I ODE (a, b) (sol t)) (ab, bb) (Inl ` ODE_dom ODE ∪ Inr ` ODE_dom ODE ∪ V) "
apply(rule exI[where x="fst (mk_v J ODE (aa, ba) (sol t))"])
apply(rule exI[where x="snd (mk_v J ODE (aa, ba) (sol t))"])
apply(rule conjI)
subgoal
apply(rule exI[where x="sol"])
apply(rule exI[where x=t])
apply(rule conjI)
subgoal
apply(auto)
done
subgoal
apply(rule conjI)
subgoal by (rule t)
subgoal
apply(rule conjI)
subgoal by (rule sol')
subgoal by (rule VSA')
done
done
done
apply(auto)
using mk_v_agree[of I ODE "(a,b)" "(sol t)"]
mk_v_agree[of J ODE "(aa,ba)" "(sol t)"]
using agree_refl t VA'foo
OVsub' Un_absorb1 by (auto simp add: OVsub' Un_absorb1)
qed
show "coincide_hp (EvolveODE ODE P) I J ∧ ode_sem_equiv (EvolveODE ODE P) I" using co_hp equiv[of I] by auto
qed
qed
next
case (hpsafe_Choice a b)
then show "?case"
proof (auto simp only: coincide_hp'_def coincide_hp_def)
fix I J::"('a,'b,'c) interp" and ν1 ν1' ν2 ν2' μ μ' V
assume safe:"hpsafe a"
"hpsafe b"
and IH1:"
∀ I J. (∀ν ν' μ V.
Iagree I J (SIGP a) ⟶
Vagree ν ν' V ⟶ FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V)))
∧ ode_sem_equiv a I"
and IH2:"∀ I J. (∀ν ν' μ V.
Iagree I J (SIGP b) ⟶
Vagree ν ν' V ⟶ FVP b ⊆ V ⟶ (ν, μ) ∈ prog_sem I b ⟶ (∃μ'. (ν', μ') ∈ prog_sem J b ∧ Vagree μ μ' (MBV b ∪ V)))
∧ ode_sem_equiv b I"
and IA:"Iagree I J (SIGP (a ∪∪ b))"
and VA:"Vagree (ν1, ν1') (ν2, ν2') V"
and sub:"FVP (a ∪∪ b) ⊆ V"
and sem:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I (a ∪∪ b)"
hence eitherSem:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I a ∨ ((ν1, ν1'), (μ, μ')) ∈ prog_sem I b"
by auto
have Ssub:"(SIGP a) ⊆ SIGP (a ∪∪ b)" "(SIGP b) ⊆ SIGP (a ∪∪ b)"
unfolding SIGP.simps by auto
have IA1:"Iagree I J (SIGP a)" and IA2:"Iagree I J (SIGP b)"
using IA Iagree_sub[OF Ssub(1)] Iagree_sub[OF Ssub(2)] by auto
from sub have sub1:"FVP a ⊆ V" and sub2:"FVP b ⊆ V" by auto
then
show "∃μ''. ((ν2, ν2'), μ'') ∈ prog_sem J (a ∪∪ b) ∧ Vagree (μ, μ') μ'' (MBV (a ∪∪ b) ∪ V)"
proof (cases "((ν1, ν1'), (μ, μ')) ∈ prog_sem I a")
case True
then obtain μ'' where prog_sem:"((ν2,ν2'), μ'') ∈ prog_sem J a" and agree:"Vagree (μ, μ') μ'' (MBV a ∪ V)"
using IH1 VA sub1 IA1 by blast
from agree have agree':"Vagree (μ, μ') μ'' (MBV (a ∪∪ b) ∪ V)"
unfolding Vagree_def MBV.simps by auto
from prog_sem have prog_sem':"((ν2,ν2'), μ'') ∈ prog_sem J (a ∪∪ b)"
unfolding prog_sem.simps by blast
from agree' and prog_sem' show ?thesis by blast
next
case False
then have sem2:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I b" using eitherSem by blast
then obtain μ'' where prog_sem:"((ν2,ν2'), μ'') ∈ prog_sem J b" and agree:"Vagree (μ, μ') μ'' (MBV b ∪ V)"
using IH2 VA sub2 IA2 by blast
from agree have agree':"Vagree (μ, μ') μ'' (MBV (a ∪∪ b) ∪ V)"
unfolding Vagree_def MBV.simps by auto
from prog_sem have prog_sem':"((ν2,ν2'), μ'') ∈ prog_sem J (a ∪∪ b)"
unfolding prog_sem.simps by blast
from agree' and prog_sem' show ?thesis by blast
qed
next
fix I
assume IHs:
"∀I J. (∀ν ν' μ V.
Iagree I J (SIGP a) ⟶
Vagree ν ν' V ⟶ FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V))) ∧
ode_sem_equiv a I"
"∀I J. (∀ν ν' μ V.
Iagree I J (SIGP b) ⟶
Vagree ν ν' V ⟶ FVP b ⊆ V ⟶ (ν, μ) ∈ prog_sem I b ⟶ (∃μ'. (ν', μ') ∈ prog_sem J b ∧ Vagree μ μ' (MBV b ∪ V))) ∧
ode_sem_equiv b I"
show "ode_sem_equiv (a ∪∪ b) I"
unfolding ode_sem_equiv_def by auto
qed
next
case (hpsafe_Sequence a b) then show "?case"
apply (unfold coincide_hp'_def coincide_hp_def)
apply (rule allI)+
apply (rule conjI)
prefer 2 subgoal unfolding ode_sem_equiv_def by auto
apply(unfold prog_sem.simps SIGP.simps FVP.simps )
apply(rule allI)+
apply(auto)
subgoal for I J ν2 ν2' V ν1 ν1' μ μ' ω ω'
proof -
assume safe:"hpsafe a" "hpsafe b"
assume "(∀I. ((∀J. Iagree I J (SIGP a) ⟶ (∀aa b ab ba ac bb V.
Vagree (aa, b) (ab, ba) V ⟶
FVP a ⊆ V ⟶ ((aa, b), ac, bb) ∈ prog_sem I a ⟶ (∃aa b. ((ab, ba), aa, b) ∈ prog_sem J a ∧ Vagree (ac, bb) (aa, b) (MBV a ∪ V)))))
∧ ode_sem_equiv a I)"
hence IH1':"⋀aa b ab ba ac bb V.
Iagree I J (SIGP a) ⟹
Vagree (aa, b) (ab, ba) V ⟹
FVP a ⊆ V ⟹ ((aa, b), ac, bb) ∈ prog_sem I a ⟹ (∃aa b. ((ab, ba), aa, b) ∈ prog_sem J a ∧ Vagree (ac, bb) (aa, b) (MBV a ∪ V))"
by auto
note IH1 = IH1'[of ν1 ν1' ν2 ν2' V μ μ']
assume IH2'':"
∀I. (∀J. Iagree I J (SIGP b) ⟶ (∀a ba aa bb ab bc V.
Vagree (a, ba) (aa, bb) V ⟶
FVP b ⊆ V ⟶ ((a, ba), ab, bc) ∈ prog_sem I b ⟶ (∃a ba. ((aa, bb), a, ba) ∈ prog_sem J b ∧ Vagree (ab, bc) (a, ba) (MBV b ∪ V))))
∧ ode_sem_equiv b I"
assume IAab:"Iagree I J (SIGP a ∪ SIGP b)"
have IAsubs:"SIGP a ⊆ (SIGP a ∪ SIGP b)" "SIGP b ⊆ (SIGP a ∪ SIGP b)" by auto
from IAab have IA:"Iagree I J (SIGP a)" "Iagree I J (SIGP b)" using Iagree_sub[OF IAsubs(1)] Iagree_sub[OF IAsubs(2)] by auto
from IH2'' have IH2':"⋀a ba aa bb ab bc V .
Iagree I J (SIGP b) ⟹
Vagree (a, ba) (aa, bb) V ⟹
FVP b ⊆ V ⟹ ((a, ba), ab, bc) ∈ prog_sem I b ⟹ (∃a ba. ((aa, bb), a, ba) ∈ prog_sem J b ∧ Vagree (ab, bc) (a, ba) (MBV b ∪ V))"
using IA by auto
assume VA:"Vagree (ν1, ν1') (ν2, ν2') V"
assume sub:"FVP a ⊆ V" "FVP b - MBV a ⊆ V"
hence sub':"FVP a ⊆ V" by auto
assume sem:"((ν1, ν1'), (μ, μ')) ∈ prog_sem I a"
"((μ, μ'), (ω, ω')) ∈ prog_sem I b"
obtain ω1 ω1' where sem1:"((ν2, ν2'), (ω1, ω1')) ∈ prog_sem J a" and VA1:"Vagree (μ, μ') (ω1, ω1') (MBV a ∪ V)"
using IH1[OF IA(1) VA sub' sem(1)] by auto
note IH2 = IH2'[of μ μ' ω1 ω1' " MBV a ∪ V" ω ω']
have sub2:"FVP b ⊆ MBV a ∪ V" using sub by auto
obtain ω2 ω2' where sem2:"((ω1, ω1'), (ω2, ω2')) ∈ prog_sem J b" and VA2:"Vagree (ω, ω') (ω2, ω2') (MBV b ∪ (MBV a ∪ V))"
using IH2[OF IA(2) VA1 sub2 sem(2)] by auto
show "∃ab bb. ((ν2, ν2'), (ab, bb)) ∈ prog_sem J a O prog_sem J b ∧ Vagree (ω, ω') (ab, bb) (MBV a ∪ MBV b ∪ V)"
using sem1 sem2 VA1 VA2
by (metis (no_types, lifting) Un_assoc Un_left_commute relcomp.relcompI)
qed
done
next
case (hpsafe_Loop a) then show "?case"
apply(unfold coincide_hp'_def coincide_hp_def)
apply(rule allI)+
apply(rule conjI)
prefer 2 subgoal unfolding ode_sem_equiv_def by auto
apply(rule allI | rule impI)+
apply(unfold prog_sem.simps FVP.simps MBV.simps SIGP.simps)
subgoal for I J ν ν' μ V
proof -
assume safe:"hpsafe a"
assume IH:"(∀ I J. (∀ν ν' μ V.
Iagree I J (SIGP a) ⟶
Vagree ν ν' V ⟶ FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V)))
∧ ode_sem_equiv a I)"
assume agree:"Iagree I J (SIGP a)"
assume VA:"Vagree ν ν' V"
assume sub:"FVP a ⊆ V"
have "(ν, μ) ∈ (prog_sem I a)⇧* ⟹ (⋀ν'. Vagree ν ν' V ⟹ ∃μ'. (ν', μ') ∈ (prog_sem J a)⇧* ∧ Vagree μ μ' ({} ∪ V))"
apply(induction rule: converse_rtrancl_induct)
apply(auto)
subgoal for ω ω' s s' v v'
proof -
assume sem1:"((ω, ω'), (s, s')) ∈ prog_sem I a"
and sem2:"((s, s'), μ) ∈ (prog_sem I a)⇧*"
and IH2:"⋀v v'. (Vagree (s, s') (v,v') V ⟹ ∃ab ba. ((v,v'), (ab, ba)) ∈ (prog_sem J a)⇧* ∧ Vagree μ (ab, ba) V)"
and VA:"Vagree (ω, ω') (v,v') V"
obtain s'' where sem'':"((v, v'), s'') ∈ prog_sem J a" and VA'':"Vagree (s,s') s'' (MBV a ∪ V)"
using IH agree VA sub sem1 agree_refl by blast
then obtain s'1 and s'2 where sem'':"((v, v'), (s'1, s'2)) ∈ prog_sem J a" and VA'':"Vagree (s,s') (s'1, s'2) (MBV a ∪ V)"
using IH agree VA sub sem1 agree_refl by (cases "s''", blast)
from VA'' have VA''V:"Vagree (s,s') (s'1, s'2) V"
using agree_sub by blast
note IH2' = IH2[of s'1 s'2]
note IH2'' = IH2'[OF VA''V]
then obtain ab and ba where sem''':"((s'1, s'2), (ab, ba)) ∈ (prog_sem J a)⇧*" and VA''':"Vagree μ (ab, ba) V"
using IH2'' by auto
from sem'' sem''' have sem:"((v, v'), (ab, ba)) ∈ (prog_sem J a)⇧*" by auto
show "∃μ'1 μ'2. ((v, v'), (μ'1, μ'2)) ∈ (prog_sem J a)⇧* ∧ Vagree μ (μ'1, μ'2) V"
using sem VA''' by blast
qed
done
then show "(ν, μ) ∈ (prog_sem I a)⇧* ⟹ Vagree ν ν' V ⟹ ∃μ'. (ν', μ') ∈ (prog_sem J a)⇧* ∧ Vagree μ μ' ({} ∪ V)"
by auto
qed
done
next
case (fsafe_Geq t1 t2)
then have safe:"dsafe t1" "dsafe t2" by auto
have almost:"⋀ν ν'. ⋀ I J :: ('a, 'b, 'c) interp. Iagree I J (SIGF (Geq t1 t2)) ⟹ Vagree ν ν' (FVF (Geq t1 t2)) ⟹ (ν ∈ fml_sem I (Geq t1 t2)) = (ν' ∈ fml_sem J (Geq t1 t2))"
proof -
fix ν ν' and I J :: "('a, 'b, 'c) interp"
assume IA:"Iagree I J (SIGF (Geq t1 t2))"
hence IAs:"Iagree I J {Inl x | x. x ∈ (SIGT t1)}"
"Iagree I J {Inl x | x. x ∈ (SIGT t2)}"
unfolding SIGF.simps Iagree_def by auto
assume VA:"Vagree ν ν' (FVF (Geq t1 t2))"
hence VAs:"Vagree ν ν' (FVT t1)" "Vagree ν ν' (FVT t2)"
unfolding FVF.simps Vagree_def by auto
have sem1:"dterm_sem I t1 ν = dterm_sem J t1 ν'"
by (auto simp add: coincidence_dterm'[OF safe(1) VAs(1) IAs(1)])
have sem2:"dterm_sem I t2 ν = dterm_sem J t2 ν'"
by (auto simp add: coincidence_dterm'[OF safe(2) VAs(2) IAs(2)])
show "(ν ∈ fml_sem I (Geq t1 t2)) = (ν' ∈ fml_sem J (Geq t1 t2))"
by (simp add: sem1 sem2)
qed
show "?case" using almost unfolding coincide_fml_def by blast
next
case (fsafe_Prop args p)
then have safes:"⋀arg. arg ∈ range args ⟹ dsafe arg" using dfree_is_dsafe by auto
have almost:"⋀ν ν'. ⋀ I J::('a, 'b, 'c) interp. Iagree I J (SIGF (Prop p args)) ⟹ Vagree ν ν' (FVF (Prop p args)) ⟹ (ν ∈ fml_sem I (Prop p args)) = (ν' ∈ fml_sem J (Prop p args))"
proof -
fix ν ν' and I J :: "('a, 'b, 'c) interp"
assume IA:"Iagree I J (SIGF (Prop p args))"
have subs:"⋀i. {Inl x | x. x ∈ SIGT (args i)} ⊆ (SIGF (Prop p args))"
by auto
have IAs:"⋀i. Iagree I J {Inl x | x. x ∈ SIGT (args i)}"
using IA apply(unfold SIGF.simps)
subgoal for i
using Iagree_sub[OF subs[of i]] by auto
done
have mem:"Inr (Inr p) ∈ {Inr (Inr p)} ∪ {Inl x |x. x ∈ (⋃i. SIGT (args i))}"
by auto
from IA have pSame:"Predicates I p = Predicates J p"
by (auto simp add: Iagree_Pred IA mem)
assume VA:"Vagree ν ν' (FVF (Prop p args))"
hence VAs:"⋀i. Vagree ν ν' (FVT (args i))"
unfolding FVF.simps Vagree_def by auto
have sems:"⋀i. dterm_sem I (args i) ν = dterm_sem J (args i) ν'"
using IAs VAs coincidence_dterm' rangeI safes
by (simp add: coincidence_dterm')
hence vecSem:"(χ i. dterm_sem I (args i) ν) = (χ i. dterm_sem J (args i) ν')"
by auto
show "(ν ∈ fml_sem I (Prop p args)) = (ν' ∈ fml_sem J (Prop p args))"
apply(unfold fml_sem.simps mem_Collect_eq)
using IA vecSem pSame by (auto)
qed
then show "?case" unfolding coincide_fml_def by blast
next
case fsafe_Not then show "?case" by auto
next
case (fsafe_And p1 p2)
then have safes:"fsafe p1" "fsafe p2"
and IH1:"∀ ν ν' I J. Iagree I J (SIGF p1) ⟶ Vagree ν ν' (FVF p1) ⟶ (ν ∈ fml_sem I p1) = (ν' ∈ fml_sem J p1)"
and IH2:"∀ ν ν' I J. Iagree I J (SIGF p2) ⟶ Vagree ν ν' (FVF p2) ⟶ (ν ∈ fml_sem I p2) = (ν' ∈ fml_sem J p2)"
by auto
have almost:"⋀ν ν' I J. Iagree I J (SIGF (And p1 p2)) ⟹ Vagree ν ν' (FVF (And p1 p2)) ⟹ (ν ∈ fml_sem I (And p1 p2)) = (ν' ∈ fml_sem J (And p1 p2))"
proof -
fix ν ν' I J
assume IA:"Iagree I J (SIGF (And p1 p2))"
have IAsubs:"(SIGF p1) ⊆ (SIGF (And p1 p2))" "(SIGF p2) ⊆ (SIGF (And p1 p2))" by auto
from IA have IAs:"Iagree I J (SIGF p1)" "Iagree I J (SIGF p2)"
using Iagree_sub[OF IAsubs(1)] Iagree_sub[OF IAsubs(2)] by auto
assume VA:"Vagree ν ν' (FVF (And p1 p2))"
hence VAs:"Vagree ν ν' (FVF p1)" "Vagree ν ν' (FVF p2)"
unfolding FVF.simps Vagree_def by auto
have eq1:"(ν ∈ fml_sem I p1) = (ν' ∈ fml_sem J p1)" using IH1 IAs VAs by blast
have eq2:"(ν ∈ fml_sem I p2) = (ν' ∈ fml_sem J p2)" using IH2 IAs VAs by blast
show "(ν ∈ fml_sem I (And p1 p2)) = (ν' ∈ fml_sem J (And p1 p2))"
using eq1 eq2 by auto
qed
then show "?case" unfolding coincide_fml_def by blast
next
case (fsafe_Exists p x)
then have safe:"fsafe p"
and IH:"∀ ν ν' I J. Iagree I J (SIGF p) ⟶ Vagree ν ν' (FVF p) ⟶ (ν ∈ fml_sem I p) = (ν' ∈ fml_sem J p)"
by auto
have almost:"⋀ν ν' I J. Iagree I J (SIGF (Exists x p)) ⟹ Vagree ν ν' (FVF (Exists x p)) ⟹ (ν ∈ fml_sem I (Exists x p)) = (ν' ∈ fml_sem J (Exists x p))"
proof -
fix ν ν' I J
assume IA:"Iagree I J (SIGF (Exists x p))"
hence IA':"Iagree I J (SIGF p)"
unfolding SIGF.simps Iagree_def by auto
assume VA:"Vagree ν ν' (FVF (Exists x p))"
hence VA':"Vagree ν ν' (FVF p - {Inl x})" by auto
hence VA'':"⋀r. Vagree (repv ν x r) (repv ν' x r) (FVF p)"
subgoal for r
unfolding Vagree_def FVF.simps repv.simps
by auto
done
have IH': "⋀r. Iagree I J (SIGF p) ⟹ Vagree (repv ν x r) (repv ν' x r) (FVF p) ⟹ ((repv ν x r) ∈ fml_sem I p) = ((repv ν' x r) ∈ fml_sem J p)"
subgoal for r
using IH apply(rule allE[where x = "repv ν x r"])
apply(erule allE[where x = "repv ν' x r"])
by (auto)
done
hence IH'':"⋀r. ((repv ν x r) ∈ fml_sem I p) = ((repv ν' x r) ∈ fml_sem J p)"
subgoal for r
using IA' VA'' by auto
done
have fact:"⋀r. (repv ν x r ∈ fml_sem I p) = (repv ν' x r ∈ fml_sem J p)"
subgoal for r
using IH'[OF IA' VA''] by auto
done
show "(ν ∈ fml_sem I (Exists x p)) = (ν' ∈ fml_sem J (Exists x p))"
apply(simp only: fml_sem.simps mem_Collect_eq)
using IH'' by auto
qed
then show "?case" unfolding coincide_fml_def by blast
next
case (fsafe_Diamond a p) then
have hsafe:"hpsafe a"
and psafe:"fsafe p"
and IH1:"∀ I J. (∀ν ν' μ V. Iagree I J (SIGP a) ⟶
Vagree ν ν' V ⟶
FVP a ⊆ V ⟶ (ν, μ) ∈ prog_sem I a ⟶ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ V)))"
and IH2:"∀ν ν' I J. Iagree I J (SIGF p) ⟶ Vagree ν ν' (FVF p) ⟶ (ν ∈ fml_sem I p) = (ν' ∈ fml_sem J p)"
unfolding coincide_hp'_def coincide_hp_def coincide_fml_def apply auto done
have almost:"⋀ν ν' I J. Iagree I J (SIGF (Diamond a p)) ⟹ Vagree ν ν' (FVF (Diamond a p)) ⟹ (ν ∈ fml_sem I (Diamond a p)) = (ν' ∈ fml_sem J (Diamond a p))"
proof -
fix ν ν' I J
assume IA:"Iagree I J (SIGF (Diamond a p))"
have IAsubs:"(SIGP a) ⊆ (SIGF (Diamond a p))" "(SIGF p) ⊆ (SIGF (Diamond a p))" by auto
from IA have IAP:"Iagree I J (SIGP a)"
and IAF:"Iagree I J (SIGF p)" using Iagree_sub[OF IAsubs(1)] Iagree_sub[OF IAsubs(2)] by auto
from IAP have IAP':"Iagree J I (SIGP a)" by (rule Iagree_comm)
from IAF have IAF':"Iagree J I (SIGF p)" by (rule Iagree_comm)
assume VA:"Vagree ν ν' (FVF (Diamond a p))"
hence VA':"Vagree ν' ν (FVF (Diamond a p))" by (rule agree_comm)
have dir1:"ν ∈ fml_sem I (Diamond a p) ⟹ ν' ∈ fml_sem J (Diamond a p)"
proof -
assume sem:"ν ∈ fml_sem I (Diamond a p)"
let ?V = "FVF (Diamond a p)"
have Vsup:"FVP a ⊆ ?V" by auto
obtain μ where prog:"(ν, μ) ∈ prog_sem I a" and fml:"μ ∈ fml_sem I p"
using sem by auto
from IH1 have IH1':
"Iagree I J (SIGP a) ⟹
Vagree ν ν' ?V ⟹
FVP a ⊆ ?V ⟹ (ν, μ) ∈ prog_sem I a ⟹ (∃μ'. (ν', μ') ∈ prog_sem J a ∧ Vagree μ μ' (MBV a ∪ ?V))"
by blast
obtain μ' where prog':"(ν', μ') ∈ prog_sem J a" and agree:"Vagree μ μ' (MBV a ∪ ?V)"
using IH1'[OF IAP VA Vsup prog] by blast
from IH2
have IH2':"Iagree I J (SIGF p) ⟹ Vagree μ μ' (FVF p) ⟹ (μ ∈ fml_sem I p) = (μ' ∈ fml_sem J p)"
by blast
have VAF:"Vagree μ μ' (FVF p)"
using agree VA by (auto simp only: Vagree_def FVF.simps)
hence IH2'':"(μ ∈ fml_sem I p) = (μ' ∈ fml_sem J p)"
using IH2'[OF IAF VAF] by auto
have fml':"μ' ∈ fml_sem J p" using IH2'' fml by auto
have "∃ μ'. (ν', μ') ∈ prog_sem J a ∧ μ' ∈ fml_sem J p" using fml' prog' by blast
then show "ν' ∈ fml_sem J (Diamond a p)"
unfolding fml_sem.simps by (auto simp only: mem_Collect_eq)
qed
have dir2:"ν' ∈ fml_sem J (Diamond a p) ⟹ ν ∈ fml_sem I (Diamond a p)"
proof -
assume sem:"ν' ∈ fml_sem J (Diamond a p)"
let ?V = "FVF (Diamond a p)"
have Vsup:"FVP a ⊆ ?V" by auto
obtain μ where prog:"(ν', μ) ∈ prog_sem J a" and fml:"μ ∈ fml_sem J p"
using sem by auto
from IH1 have IH1':
"Iagree J I (SIGP a) ⟹
Vagree ν' ν ?V ⟹
FVP a ⊆ ?V ⟹ (ν', μ) ∈ prog_sem J a ⟹ (∃μ'. (ν, μ') ∈ prog_sem I a ∧ Vagree μ μ' (MBV a ∪ ?V))"
by blast
obtain μ' where prog':"(ν, μ') ∈ prog_sem I a" and agree:"Vagree μ μ' (MBV a ∪ ?V)"
using IH1'[OF IAP' VA' Vsup prog] by blast
from IH2
have IH2':"Iagree J I (SIGF p) ⟹ Vagree μ μ' (FVF p) ⟹ (μ ∈ fml_sem J p) = (μ' ∈ fml_sem I p)"
by blast
have VAF:"Vagree μ μ' (FVF p)"
using agree VA by (auto simp only: Vagree_def FVF.simps)
hence IH2'':"(μ ∈ fml_sem J p) = (μ' ∈ fml_sem I p)"
using IH2'[OF IAF' VAF] by auto
have fml':"μ' ∈ fml_sem I p" using IH2'' fml by auto
have "∃ μ'. (ν, μ') ∈ prog_sem I a ∧ μ' ∈ fml_sem I p" using fml' prog' by blast
then show "ν ∈ fml_sem I (Diamond a p)"
unfolding fml_sem.simps by (auto simp only: mem_Collect_eq)
qed
show "(ν ∈ fml_sem I (Diamond a p)) = (ν' ∈ fml_sem J (Diamond a p))"
using dir1 dir2 by auto
qed
then show "?case" unfolding coincide_fml_def by blast
next
case (fsafe_InContext φ) then
have safe:"fsafe φ"
and IH:"(∀ ν ν' I J. Iagree I J (SIGF φ) ⟶ Vagree ν ν' (FVF φ) ⟶ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"
by (unfold coincide_fml_def)
hence IH':"⋀ν ν' I J. Iagree I J (SIGF φ) ⟹ Vagree ν ν' (FVF φ) ⟹ ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ"
by auto
hence sem_eq:"⋀I J. Iagree I J (SIGF φ) ⟹ fml_sem I φ = fml_sem J φ"
apply (auto simp: Collect_cong Collect_mem_eq agree_refl)
using agree_refl by blast+
have "(⋀ ν ν' I J C . Iagree I J (SIGF (InContext C φ)) ⟹ Vagree ν ν' (FVF (InContext C φ)) ⟹ ν ∈ fml_sem I (InContext C φ) ⟷ ν' ∈ fml_sem J (InContext C φ))"
proof -
fix ν ν' I J C
assume IA:"Iagree I J (SIGF (InContext C φ))"
then have IA':"Iagree I J (SIGF φ)" unfolding SIGF.simps Iagree_def by auto
assume VA:"Vagree ν ν' (FVF (InContext C φ))"
then have VAU:"Vagree ν ν' UNIV" unfolding FVF.simps Vagree_def by auto
then have VA':"Vagree ν ν' (FVF φ)" unfolding FVF.simps Vagree_def by auto
from VAU have eq:"ν = ν'" by (cases "ν", cases "ν'", auto simp add: vec_eq_iff Vagree_def)
from IA have Cmem:"Inr (Inl C) ∈ SIGF (InContext C φ)"
by simp
have Cagree:"Contexts I C = Contexts J C" by (rule Iagree_Contexts[OF IA Cmem])
show "ν ∈ fml_sem I (InContext C φ) ⟷ ν' ∈ fml_sem J (InContext C φ)"
using Cagree eq sem_eq IA' by (auto)
qed
then show "?case" by simp
qed
lemma coincidence_formula:"⋀ν ν' I J. fsafe (φ::('a::finite, 'b::finite, 'c::finite) formula) ⟹ Iagree I J (SIGF φ) ⟹ Vagree ν ν' (FVF φ) ⟹ (ν ∈ fml_sem I φ ⟷ ν' ∈ fml_sem J φ)"
using coincidence_hp_fml unfolding coincide_fml_def by blast
lemma coincidence_hp:
fixes ν ν' μ V I J
assumes safe:"hpsafe (α::('a::finite, 'b::finite, 'c::finite) hp)"
assumes IA:"Iagree I J (SIGP α)"
assumes VA:"Vagree ν ν' V"
assumes sub:"V ⊇ (FVP α)"
assumes sem:"(ν, μ) ∈ prog_sem I α"
shows "(∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V))"
proof -
have thing:"(∀I J. (∀ν ν' μ V.
Iagree I J (SIGP α) ⟶
Vagree ν ν' V ⟶ FVP α ⊆ V ⟶ (ν, μ) ∈ prog_sem I α ⟶ (∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V))) ∧
ode_sem_equiv α I)"
using coincidence_hp_fml unfolding coincide_hp_def coincide_hp'_def
using safe by blast
then have "(Iagree I J (SIGP α) ⟹
Vagree ν ν' V ⟹ FVP α ⊆ V ⟹ (ν, μ) ∈ prog_sem I α ⟹ (∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V)))"
using IA VA sub sem thing by blast
then show "(∃μ'. (ν', μ') ∈ prog_sem J α ∧ Vagree μ μ' (MBV α ∪ V))"
using IA VA sub sem by auto
qed
subsection ‹Corollaries: Alternate ODE semantics definition›
lemma ode_sem_eq:
fixes I::"('a::finite,'b::finite,'c::finite) interp" and ODE::"('a,'c) ODE" and φ::"('a,'b,'c) formula"
assumes osafe:"osafe ODE"
assumes fsafe:"fsafe φ"
shows
"({(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE φ)}}) =
({(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
(sol 0) = (fst ν)})"
proof -
have hpsafe:"hpsafe (EvolveODE ODE φ)" using osafe fsafe by (auto intro: hpsafe_fsafe.intros)
have "coincide_hp'(EvolveODE ODE φ)" using coincidence_hp_fml hpsafe by blast
hence "ode_sem_equiv (EvolveODE ODE φ) I" unfolding coincide_hp'_def by auto
then show "?thesis"
unfolding ode_sem_equiv_def using osafe fsafe by auto
qed
lemma ode_alt_sem:"⋀I::('a::finite,'b::finite,'c::finite) interp. ⋀ODE::('a,'c) ODE. ⋀φ::('a,'b,'c)formula. osafe ODE ⟹ fsafe φ ⟹
prog_sem I (EvolveODE ODE φ)
=
{(ν, mk_v I ODE ν (sol t)) | ν sol t.
t ≥ 0 ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν x ∈ fml_sem I φ} ∧
VSagree (sol 0) (fst ν) {x | x. Inl x ∈ FVP (EvolveODE ODE φ)}}
"
subgoal for I ODE φ
using ode_sem_eq[of ODE φ I] by auto
done
end
end
Theory Bound_Effect
theory "Bound_Effect"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Frechet_Correctness"
"Static_Semantics"
"Coincidence"
begin
section ‹Bound Effect Theorem›
text ‹The bound effect lemma says that a program can only modify its bound variables and nothing else.
This is one of the major lemmas for showing correctness of uniform substitution. ›
context ids begin
lemma bound_effect:
fixes I::"('sf,'sc,'sz) interp"
assumes good_interp:"is_interp I"
shows "⋀ν :: 'sz state. ⋀ω ::'sz state. hpsafe α ⟹ (ν, ω) ∈ prog_sem I α ⟹ Vagree ν ω (- (BVP α))"
proof (induct rule: hp_induct)
case Var then show "?case"
using agree_nil Compl_UNIV_eq BVP.simps(1) by fastforce
next
case Test then show "?case"
by auto(simp add: agree_refl Compl_UNIV_eq Vagree_def)
next
case (Choice a b ν ω)
assume IH1:"⋀ν'. ⋀ω'. hpsafe a ⟹((ν', ω') ∈ prog_sem I a ⟹ Vagree ν' ω' (- BVP a))"
assume IH2:"⋀ν'. ⋀ω'. hpsafe b ⟹((ν', ω') ∈ prog_sem I b ⟹ Vagree ν' ω' (- BVP b))"
assume sem:"(ν, ω) ∈ prog_sem I (a ∪∪ b)"
assume safe:"hpsafe (Choice a b)"
from safe have safes:"hpsafe a" "hpsafe b" by (auto dest: hpsafe.cases)
have sems:"(ν, ω) ∈ prog_sem I (a) ∨ (ν, ω) ∈ prog_sem I (b)" using sem by auto
have agrees:"Vagree ν ω (- BVP a) ∨ Vagree ν ω (- BVP b)" using IH1 IH2 sems safes by blast
have sub1:"-(BVP a) ⊇ (- BVP a ∩ - BVP b)" by auto
have sub2:"-(BVP a) ⊇ (- BVP a ∩ - BVP b)" by auto
have res:"Vagree ν ω (- BVP a ∩ - BVP b)" using agrees sub1 sub2 agree_supset by blast
then show "?case" by auto
next
case (Compose a b ν ω)
assume IH1:"⋀ν'. ⋀ω'. hpsafe a ⟹ (ν', ω') ∈ prog_sem I a ⟹ Vagree ν' ω' (- BVP a)"
assume IH2:"⋀ν'. ⋀ω'. hpsafe b ⟹ (ν', ω') ∈ prog_sem I b ⟹ Vagree ν' ω' (- BVP b)"
assume sem:"(ν, ω) ∈ prog_sem I (a ;; b)"
assume safe:"hpsafe (a ;; b)"
from safe have safes:"hpsafe a" "hpsafe b" by (auto dest: hpsafe.cases)
then show "?case"
using agree_trans IH1 IH2 sem safes by fastforce
next
fix ODE::"('sf,'sz) ODE" and P::"('sf,'sc,'sz) formula" and ν ω
assume safe:"hpsafe (EvolveODE ODE P)"
from safe have osafe:"osafe ODE" and fsafe:"fsafe P" by (auto dest: hpsafe.cases)
show "(ν, ω) ∈ prog_sem I (EvolveODE ODE P) ⟹ Vagree ν ω (- BVP (EvolveODE ODE P))"
proof -
assume sem:"(ν, ω) ∈ prog_sem I (EvolveODE ODE P)"
from sem have agree:"Vagree ν ω (- BVO ODE)"
apply(simp only: prog_sem.simps(8) mem_Collect_eq osafe fsafe)
apply(erule exE)+
proof -
fix ν' sol t
assume assm:
"(ν, ω) = (ν', mk_v I ODE ν' (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} {x. mk_v I ODE ν' x ∈ fml_sem I P} ∧ (sol 0) = (fst ν')"
have semBV:"-BVO ODE ⊆ -semBV I ODE"
by(induction ODE, auto)
from assm have "Vagree ω ν (- BVO ODE)" using mk_v_agree[of I ODE ν "(sol t)"]
using agree_sub[OF semBV] by auto
thus "Vagree ν ω (- BVO ODE)" by (rule agree_comm)
qed
thus "Vagree ν ω (- BVP (EvolveODE ODE P))" by auto
qed
next
case (Star a ν ω) then
have IH:"(⋀ν ω. hpsafe a ⟹ (ν, ω) ∈ prog_sem I a ⟹ Vagree ν ω (- BVP a))"
and safe:"hpsafe a**"
and sem:"(ν, ω) ∈ prog_sem I a**"
by auto
from safe have asafe:"hpsafe a" by (auto dest: hpsafe.cases)
show "Vagree ν ω (- BVP a**)"
using sem apply (simp only: prog_sem.simps)
apply (erule converse_rtrancl_induct)
subgoal by(rule agree_refl)
subgoal for y z using IH[of y z, OF asafe] sem by (auto simp add: Vagree_def)
done
qed (auto simp add: Vagree_def)
end end
Theory Differential_Axioms
theory "Differential_Axioms"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Frechet_Correctness"
"Axioms"
"Coincidence"
begin context ids begin
section ‹Differential Axioms›
text ‹Differential axioms fall into two categories:
Axioms for computing the derivatives of terms and axioms for proving properties of ODEs.
The derivative axioms are all corollaries of the frechet correctness theorem. The ODE
axioms are more involved, often requiring extensive use of the ODE libraries.›
subsection ‹Derivative Axioms›
definition diff_const_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_const_axiom ≡ Equals (Differential ($f fid1 empty)) (Const 0)"
definition diff_var_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_var_axiom ≡ Equals (Differential (Var vid1)) (DiffVar vid1)"
definition state_fun ::"'sf ⇒ ('sf, 'sz) trm"
where [axiom_defs]:"state_fun f = ($f f (λi. Var i))"
definition diff_plus_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_plus_axiom ≡ Equals (Differential (Plus (state_fun fid1) (state_fun fid2)))
(Plus (Differential (state_fun fid1)) (Differential (state_fun fid2)))"
definition diff_times_axiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_times_axiom ≡ Equals (Differential (Times (state_fun fid1) (state_fun fid2)))
(Plus (Times (Differential (state_fun fid1)) (state_fun fid2))
(Times (state_fun fid1) (Differential (state_fun fid2))))"
definition diff_chain_axiom::"('sf, 'sc, 'sz) formula"
where [axiom_defs]:"diff_chain_axiom ≡ [[Assign vid2 (f1 fid2 vid1)]]([[DiffAssign vid2 (Const 1)]]
(Equals (Differential ($f fid1 (singleton (f1 fid2 vid1)))) (Times (Differential (f1 fid1 vid2)) (Differential (f1 fid2 vid1)))))"
subsection ‹ODE Axioms›
definition DWaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DWaxiom = ([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid1))"
definition DWaxiom' :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DWaxiom' = ([[EvolveODE (OSing vid1 (Function fid1 (singleton (Var vid1)))) (Prop vid2 (singleton (Var vid1)))]](Prop vid2 (singleton (Var vid1))))"
definition DCaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DCaxiom = (
([[EvolveODE (OVar vid1) (Predicational pid1)]]Predicational pid3) →
(([[EvolveODE (OVar vid1) (Predicational pid1)]](Predicational pid2))
↔
([[EvolveODE (OVar vid1) (And (Predicational pid1) (Predicational pid3))]]Predicational pid2)))"
definition DEaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DEaxiom =
(([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]] (P pid1))
↔
([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid2 vid1)]]
[[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
definition DSaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DSaxiom =
(([[EvolveODE (OSing vid1 (f0 fid1)) (p1 vid2 vid1)]]p1 vid3 vid1)
↔
(Forall vid2
(Implies (Geq (Var vid2) (Const 0))
(Implies
(Forall vid3
(Implies (And (Geq (Var vid3) (Const 0)) (Geq (Var vid2) (Var vid3)))
(Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))))
([[Assign vid1 (Plus (Var vid1) (Times (f0 fid1) (Var vid2)))]]p1 vid3 vid1)))))"
definition DIGeqaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DIGeqaxiom =
Implies
(Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
(Implies
(Implies(Prop vid1 empty) (Geq (f1 fid1 vid1) (f1 fid2 vid1)))
([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (f1 fid1 vid1) (f1 fid2 vid1))))"
definition DIGraxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DIGraxiom =
Implies
(Implies (Prop vid1 empty) ([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Geq (Differential (f1 fid1 vid1)) (Differential (f1 fid2 vid1)))))
(Implies
(Implies(Prop vid1 empty) (Greater (f1 fid1 vid1) (f1 fid2 vid1)))
([[EvolveODE (OVar vid1) (Prop vid1 empty)]](Greater (f1 fid1 vid1) (f1 fid2 vid1))))"
definition DGaxiom :: "('sf, 'sc, 'sz) formula"
where [axiom_defs]:"DGaxiom = (([[EvolveODE (OSing vid1 (f1 fid1 vid1)) (p1 vid1 vid1)]]p1 vid2 vid1) ↔
(Exists vid2
([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (Var vid2)) (f1 fid3 vid1)))) (p1 vid1 vid1)]]
p1 vid2 vid1)))"
subsection ‹Proofs for Derivative Axioms›
lemma constant_deriv_inner:
assumes interp:"∀x i. (Functions I i has_derivative FunctionFrechet I i x) (at x)"
shows "FunctionFrechet I id1 (vec_lambda (λi. sterm_sem I (empty i) (fst ν))) (vec_lambda(λi. frechet I (empty i) (fst ν) (snd ν)))= 0"
proof -
have empty_zero:"(vec_lambda(λi. frechet I (empty i) (fst ν) (snd ν))) = 0"
using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
apply auto
apply(rule vec_extensionality)
using local.empty_def Cart_lambda_cong frechet.simps(5) zero_vec_def
by (simp add: local.empty_def)
let ?x = "(vec_lambda (λi. sterm_sem I (empty i) (fst ν)))"
from interp
have has_deriv:"(Functions I id1 has_derivative FunctionFrechet I id1 ?x) (at ?x)"
by auto
then have f_linear:"linear (FunctionFrechet I id1 ?x)"
using Deriv.has_derivative_linear by auto
then show ?thesis using empty_zero f_linear linear_0 by (auto)
qed
lemma constant_deriv_zero:"is_interp I ⟹ directional_derivative I ($f id1 empty) ν = 0"
apply(simp only: is_interp_def directional_derivative_def frechet.simps frechet_correctness)
apply(rule constant_deriv_inner)
apply(auto)
done
theorem diff_const_axiom_valid: "valid diff_const_axiom"
apply(simp only: valid_def diff_const_axiom_def equals_sem)
apply(rule allI | rule impI)+
apply(simp only: dterm_sem.simps constant_deriv_zero sterm_sem.simps)
done
theorem diff_var_axiom_valid: "valid diff_var_axiom"
apply(auto simp add: diff_var_axiom_def valid_def directional_derivative_def)
by (metis inner_prod_eq)
theorem diff_plus_axiom_valid: "valid diff_plus_axiom"
apply(auto simp add: diff_plus_axiom_def valid_def)
subgoal for I a b
using frechet_correctness[of I "(Plus (state_fun fid1) (state_fun fid2))" b]
unfolding state_fun_def apply (auto intro: dfree.intros)
unfolding directional_derivative_def by auto
done
theorem diff_times_axiom_valid: "valid diff_times_axiom"
apply(auto simp add: diff_times_axiom_def valid_def)
subgoal for I a b
using frechet_correctness[of I "(Times (state_fun fid1) (state_fun fid2))" b]
unfolding state_fun_def apply (auto intro: dfree.intros)
unfolding directional_derivative_def by auto
done
subsection ‹Proofs for ODE Axioms›
lemma DW_valid:"valid DWaxiom"
apply(unfold DWaxiom_def valid_def Let_def impl_sem )
apply(safe)
apply(auto simp only: fml_sem.simps prog_sem.simps box_sem)
subgoal for I aa ba ab bb sol t using mk_v_agree[of I "(OVar vid1)" "(ab,bb)" "sol t"]
Vagree_univ[of "aa" "ba" "sol t" "ODEs I vid1 (sol t)"] solves_ode_domainD
by (fastforce)
done
lemma DE_lemma:
fixes ab bb::"'sz simple_state"
and sol::"real ⇒ 'sz simple_state"
and I::"('sf, 'sc, 'sz) interp"
shows
"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
= mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
proof
have set_eq:" {Inl vid1, Inr vid1} = {Inr vid1, Inl vid1}" by auto
have agree:"Vagree (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) (mk_xode I (OSing vid1 (f1 fid1 vid1)) (sol t))
{Inl vid1, Inr vid1}"
using mk_v_agree[of I "(OSing vid1 (f1 fid1 vid1))" "(ab, bb)" "(sol t)"]
unfolding semBV.simps using set_eq by auto
have fact:"dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))
= snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1"
using agree unfolding Vagree_def dterm_sem.simps f1_def mk_xode.simps
proof -
assume alls:"(∀i. Inl i ∈ {Inl vid1, Inr vid1} ⟶
fst (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
fst (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i) ∧
(∀i. Inr i ∈ {Inl vid1, Inr vid1} ⟶
snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ i =
snd (sol t, ODE_sem I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (sol t)) $ i)"
hence atVid'':"snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1 = sterm_sem I ($f fid1 (singleton (trm.Var vid1))) (sol t)"
by auto
have argsEq:"(χ i. dterm_sem I (singleton (trm.Var vid1) i)
(mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)))
= (χ i. sterm_sem I (singleton (trm.Var vid1) i) (sol t))"
using alls f1_def by auto
thus "Functions I fid1 (χ i. dterm_sem I (singleton (trm.Var vid1) i)
(mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)))
= snd (mk_v I (OSing vid1 ($f fid1 (singleton (trm.Var vid1)))) (ab, bb) (sol t)) $ vid1"
by (simp only: atVid'' ODE_sem.simps sterm_sem.simps dterm_sem.simps)
qed
have eqSnd:"(χ y. if vid1 = y then snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ vid1
else snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) $ y) = snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"
by (simp add: vec_extensionality)
have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
(dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
= mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
using fact by (auto simp only: eqSnd repd.simps fact prod.collapse split: if_split)
thus "fst (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
(dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
fst (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))"
"snd (repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
(dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))) =
snd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) "
by auto
qed
lemma DE_valid:"valid DEaxiom"
proof -
have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
by (simp add: osafe_Sing dfree_Const)
have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
using dsafe dsafe_Fun_simps image_iff
by (simp add: dfree_Const)
show "valid DEaxiom"
apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem)
proof -
fix I::"('sf,'sc,'sz) interp"
and aa ba ab bb sol
and t::real
and ac bc
assume "is_interp I"
assume allw:"∀ω. (∃ν sol t.
((ab, bb), ω) = (ν, mk_v I (OSing vid1 (f1 fid1 vid1)) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
{x. mk_v I (OSing vid1 (f1 fid1 vid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
(sol 0) = (fst ν) ) ⟶
ω ∈ fml_sem I (P pid1)"
assume t:"0 ≤ t"
assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
assume solve:" (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
{x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
assume sol0:" (sol 0) = (fst (ab, bb)) "
assume rep:" (ac, bc) =
repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
(dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))"
have aaba_sem:"(aa,ba) ∈ fml_sem I (P pid1)" using allw t aaba solve sol0 rep by blast
have truth:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
(dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
= mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
using DE_lemma by auto
show "
repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1
(dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
∈ fml_sem I (P pid1)" using aaba aaba_sem truth by (auto)
next
fix I::"('sf,'sc,'sz) interp" and aa ba ab bb sol and t::real
assume "is_interp I"
assume all:"∀ω. (∃ν sol t.
((ab, bb), ω) = (ν, mk_v I (OSing vid1 (f1 fid1 vid1)) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
{x. mk_v I (OSing vid1 (f1 fid1 vid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
(sol 0) = (fst ν) ) ⟶
(∀ω'. ω' = repd ω vid1 (dterm_sem I (f1 fid1 vid1) ω) ⟶ ω' ∈ fml_sem I (P pid1))"
hence justW:"(∃ν sol t.
((ab, bb), (aa, ba)) = (ν, mk_v I (OSing vid1 (f1 fid1 vid1)) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
{x. mk_v I (OSing vid1 (f1 fid1 vid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
(sol 0) = (fst ν)) ⟶
(∀ω'. ω' = repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) ⟶ ω' ∈ fml_sem I (P pid1))"
by (rule allE)
assume t:"0 ≤ t"
assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)"
assume sol:"(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f1 fid1 vid1)))) {0..t}
{x. mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
assume sol0:" (sol 0) = (fst (ab, bb))"
have "repd (aa, ba) vid1 (dterm_sem I (f1 fid1 vid1) (aa, ba)) ∈ fml_sem I (P pid1)"
using justW t aaba sol sol0 by auto
hence foo:"repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t))) ∈ fml_sem I (P pid1)"
using aaba by auto
hence "repd (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)) vid1 (dterm_sem I (f1 fid1 vid1) (mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)))
= mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t)" using DE_lemma by auto
thus "mk_v I (OSing vid1 (f1 fid1 vid1)) (ab, bb) (sol t) ∈ fml_sem I (P pid1)" using foo by auto
qed
qed
lemma ODE_zero:"⋀i. Inl i ∉ BVO ODE ⟹ Inr i ∉ BVO ODE ⟹ ODE_sem I ODE ν $ i= 0"
by(induction ODE, auto)
lemma DE_sys_valid:
assumes disj:"{Inl vid1, Inr vid1} ∩ BVO ODE = {}"
shows "valid (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
[[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
proof -
have dsafe:"dsafe ($f fid1 (singleton (trm.Var vid1)))" unfolding singleton_def by(auto intro: dsafe.intros)
have osafe:"osafe(OSing vid1 (f1 fid1 vid1))" unfolding f1_def empty_def singleton_def using dsafe osafe.intros dsafe.intros
by (simp add: osafe_Sing dfree_Const)
have fsafe:"fsafe (p1 vid2 vid1)" unfolding p1_def singleton_def using hpsafe_fsafe.intros(10)
using dsafe dsafe_Fun_simps image_iff
by (simp add: dfree_Const)
show "valid (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1)) ODE)) (p1 vid2 vid1)]]
[[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
apply(auto simp only: DEaxiom_def valid_def Let_def iff_sem impl_sem)
apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq box_sem f1_def p1_def P_def expand_singleton)
proof -
fix I ::"('sf,'sc,'sz) interp"
and aa ba ab bb sol
and t::real
and ac bc
assume good:"is_interp I"
assume bigAll:"
∀ω. (∃ν sol t. ((ab, bb), ω) = (ν, mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) ODE) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OProd(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) ODE ))) {0..t}
{x. Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
sol 0 = fst ν) ⟶
ω ∈ fml_sem I (Pc pid1)"
let ?myω = "mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab,bb) (sol t)"
assume t:"0 ≤ t"
assume aaba:"(aa, ba) = mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
assume sol:"(sol solves_ode (λ_. ODE_sem I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
{x. Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
assume sol0:"sol 0 = fst (ab, bb)"
assume acbc:"(ac, bc) =
repd (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
(dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
have bigEx:"(∃ν sol t. ((ab, bb), ?myω) = (ν, mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
{x. Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
sol 0 = fst ν)"
apply(rule exI[where x="(ab, bb)"])
apply(rule exI[where x="sol"])
apply(rule exI[where x="t"])
apply(rule conjI)
apply(rule refl)
apply(rule conjI)
apply(rule t)
apply(rule conjI)
using sol apply blast
by (rule sol0)
have bigRes:"?myω ∈ fml_sem I (Pc pid1)" using bigAll bigEx by blast
have notin1:"Inl vid1 ∉ BVO ODE" using disj by auto
have notin2:"Inr vid1 ∉ BVO ODE" using disj by auto
have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
using ODE_zero notin1 notin2
by blast
have vec_eq:"(χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t)) =
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))"
apply(rule vec_extensionality)
apply simp
using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
by(simp add: Vagree_def)
have sem_eq:"(?myω ∈ fml_sem I (Pc pid1)) = ((repd (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
(dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))) ∈ fml_sem I (Pc pid1))"
apply(rule coincidence_formula)
subgoal by simp
subgoal by (rule Iagree_refl)
using mk_v_agree[of "I" "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
unfolding Vagree_def
apply simp
apply(erule conjE)+
apply(erule allE[where x="vid1"])+
apply(simp add: ODE_sem)
using vec_eq by simp
show "repd (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
(dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)))
∈ fml_sem I (Pc pid1)"
using bigRes sem_eq by blast
next
fix I::"('sf,'sc,'sz)interp"
and aa ba ab bb sol
and t::real
assume good_interp:"is_interp I"
assume all:"∀ω. (∃ν sol t. ((ab, bb), ω) = (ν, mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
{x. Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
sol 0 = fst ν) ⟶
(∀ω'. ω' = repd ω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ω) ⟶ ω' ∈ fml_sem I (Pc pid1))"
let ?myω = "mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
assume t:"0 ≤ t"
assume aaba:"(aa, ba) = mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)"
assume sol:"
(sol solves_ode (λ_. ODE_sem I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
{x. Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) x))}"
assume sol0:"sol 0 = fst (ab, bb)"
have bigEx:"(∃ν sol t. ((ab, bb), ?myω) = (ν, mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE))) {0..t}
{x. Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) ν x))} ∧
sol 0 = fst ν)"
apply(rule exI[where x="(ab, bb)"])
apply(rule exI[where x=sol])
apply(rule exI[where x=t])
apply(rule conjI)
apply(rule refl)
apply(rule conjI)
apply(rule t)
apply(rule conjI)
using sol sol0 by(blast)+
have rep_sem_eq:"repd (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
(dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) ∈ fml_sem I (Pc pid1)
= (repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ∈ fml_sem I (Pc pid1))"
apply(rule coincidence_formula)
subgoal by simp
subgoal by (rule Iagree_refl)
by(simp add: Vagree_def)
have notin1:"Inl vid1 ∉ BVO ODE" using disj by auto
have notin2:"Inr vid1 ∉ BVO ODE" using disj by auto
have ODE_sem:"ODE_sem I ODE (sol t) $ vid1 = 0"
using ODE_zero notin1 notin2
by blast
have vec_eq:"
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) =
(χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol t))"
apply(rule vec_extensionality)
using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
by (simp add: Vagree_def)
have sem_eq:
"(repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ∈ fml_sem I (Pc pid1))
= (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) ∈ fml_sem I (Pc pid1)) "
apply(rule coincidence_formula)
subgoal by simp
subgoal by (rule Iagree_refl)
using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE)" "(ab, bb)" "(sol t)"]
unfolding Vagree_def apply simp
apply(erule conjE)+
apply(erule allE[where x=vid1])+
by (simp add: ODE_sem vec_eq)
have some_sem:"repd (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t)) vid1
(dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t))) ∈ fml_sem I (Pc pid1)"
using rep_sem_eq
using all bigEx by blast
have bigImp:"(∀ω'. ω' = repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ⟶ ω' ∈ fml_sem I (Pc pid1))"
apply(rule allI)
apply(rule impI)
apply auto
using some_sem by auto
have fml_sem:"repd ?myω vid1 (dterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ?myω) ∈ fml_sem I (Pc pid1)"
using sem_eq bigImp by blast
show "mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))ODE) (ab, bb) (sol t) ∈ fml_sem I (Pc pid1)"
using fml_sem sem_eq by blast
qed
qed
lemma DC_valid:"valid DCaxiom"
proof (auto simp only: fml_sem.simps prog_sem.simps DCaxiom_def valid_def iff_sem impl_sem box_sem, auto)
fix I::"('sf,'sc,'sz) interp" and aa ba bb sol t
assume "is_interp I"
and all3:"∀a b. (∃sola. sol 0 = sola 0 ∧
(∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟶
(a, b) ∈ Contexts I pid3 UNIV"
and all2:"∀a b. (∃sola. sol 0 = sola 0 ∧
(∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟶
(a, b) ∈ Contexts I pid2 UNIV"
and t:"0 ≤ t"
and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV ∧ mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid3 UNIV}"
from sol have
sol1:"(sol solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV}"
by (metis (mono_tags, lifting) Collect_mono solves_ode_supset_range)
from all2 have all2':"⋀v. (∃sola. sol 0 = sola 0 ∧
(∃t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟹
v ∈ Contexts I pid2 UNIV" by auto
show "mk_v I (OVar vid1) (sol 0, bb) (sol t) ∈ Contexts I pid2 UNIV"
apply(rule all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"])
apply(rule exI[where x=sol])
apply(rule conjI)
subgoal by (rule refl)
subgoal using t sol1 by auto
done
next
fix I::"('sf,'sc,'sz) interp" and aa ba bb sol t
assume "is_interp I"
and all3:"∀a b. (∃sola. sol 0 = sola 0 ∧
(∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟶
(a, b) ∈ Contexts I pid3 UNIV"
and all2:"∀a b. (∃sola. sol 0 = sola 0 ∧
(∃t. (a, b) = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
0 ≤ t ∧
(sola solves_ode (λa. ODEs I vid1)) {0..t}
{x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV ∧
mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid3 UNIV})) ⟶
(a, b) ∈ Contexts I pid2 UNIV"
and t:"0 ≤ t"
and aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, bb) (sol t)"
and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV}"
from all2
have all2':"⋀v. (∃sola. sol 0 = sola 0 ∧
(∃t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
0 ≤ t ∧
(sola solves_ode (λa. ODEs I vid1)) {0..t}
{x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV ∧
mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid3 UNIV})) ⟹
v ∈ Contexts I pid2 UNIV"
by auto
from all3
have all3':"⋀v. (∃sola. sol 0 = sola 0 ∧
(∃t. v = mk_v I (OVar vid1) (sola 0, bb) (sola t) ∧
0 ≤ t ∧ (sola solves_ode (λa. ODEs I vid1)) {0..t} {x. mk_v I (OVar vid1) (sola 0, bb) x ∈ Contexts I pid1 UNIV})) ⟹
v ∈ Contexts I pid3 UNIV"
by auto
have inp1:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid1 UNIV"
using sol solves_odeD atLeastAtMost_iff by blast
have inp3:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid3 UNIV"
apply(rule all3')
subgoal for s
apply(rule exI [where x=sol])
apply(rule conjI)
subgoal by (rule refl)
apply(rule exI [where x=s])
apply(rule conjI)
subgoal by (rule refl)
apply(rule conjI)
subgoal by assumption
subgoal using sol by (meson atLeastatMost_subset_iff order_refl solves_ode_subset)
done
done
have inp13:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid1 UNIV ∧ mk_v I (OVar vid1) (sol 0, bb) (sol s) ∈ Contexts I pid3 UNIV"
using inp1 inp3 by auto
have sol13:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid1 UNIV ∧ mk_v I (OVar vid1) (sol 0, bb) x ∈ Contexts I pid3 UNIV}"
apply(rule solves_odeI)
subgoal using sol by (rule solves_odeD)
subgoal for s using inp13[of s] by auto
done
show "mk_v I (OVar vid1) (sol 0, bb) (sol t) ∈ Contexts I pid2 UNIV"
using t sol13 all2'[of "mk_v I (OVar vid1) (sol 0, bb) (sol t)"] by auto
qed
lemma DS_valid:"valid DSaxiom"
proof -
have dsafe:"dsafe($f fid1 (λi. Const 0))"
using dsafe_Const by auto
have osafe:"osafe(OSing vid1 (f0 fid1))"
unfolding f0_def empty_def
using dsafe osafe.intros
by (simp add: osafe_Sing dfree_Const)
have fsafe:"fsafe(p1 vid2 vid1)"
unfolding p1_def
apply(rule fsafe_Prop)
using singleton.simps dsafe_Const by (auto intro: dfree.intros)
show "valid DSaxiom"
apply(auto simp only: DSaxiom_def valid_def Let_def iff_sem impl_sem box_sem)
apply(auto simp only: fml_sem.simps prog_sem.simps mem_Collect_eq iff_sem impl_sem box_sem forall_sem)
proof -
fix I::"('sf,'sc,'sz) interp"
and a b r aa ba
assume good_interp:"is_interp I"
assume allW:"∀ω. (∃ν sol t.
((a, b), ω) = (ν, mk_v I (OSing vid1 (f0 fid1)) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
{x. mk_v I (OSing vid1 (f0 fid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
(sol 0) = (fst ν)) ⟶
ω ∈ fml_sem I (p1 vid3 vid1)"
assume "dterm_sem I (Const 0) (repv (a, b) vid2 r) ≤ dterm_sem I (trm.Var vid2) (repv (a, b) vid2 r)"
hence leq:"0 ≤ r" by (auto)
assume "∀ra. repv (repv (a, b) vid2 r) vid3 ra
∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
{v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
Predicates I vid2
(χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
(repv (repv (a, b) vid2 r) vid3 ra))"
hence constraint:"∀ra. (0 ≤ ra ∧ ra ≤ r) ⟶
(repv (repv (a, b) vid2 r) vid3 ra)
∈ fml_sem I (Prop vid2 (singleton (Plus (Var vid1) (Times (f0 fid1) (Var vid3)))))"
using leq by auto
assume aaba:" (aa, ba) =
repv (repv (a, b) vid2 r) vid1
(dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
let ?abba = "repv (repd (a, b) vid1 (Functions I fid1 (χ i. 0))) vid1
(dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))"
from allW have thisW:"(∃ν sol t.
((a, b), ?abba) = (ν, mk_v I (OSing vid1 (f0 fid1)) ν (sol t)) ∧
0 ≤ t ∧
(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
{x. mk_v I (OSing vid1 (f0 fid1)) ν x ∈ fml_sem I (p1 vid2 vid1)} ∧
(sol 0) = (fst ν)) ⟶
?abba ∈ fml_sem I (p1 vid3 vid1)" by blast
let ?c = "Functions I fid1 (χ _. 0)"
let ?sol = "(λt. χ i. if i = vid1 then (a $ i) + ?c * t else (a $ i))"
have agrees:"Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r)) (a, b) (- semBV I (OSing vid1 (f0 fid1)))
∧ Vagree (mk_v I (OSing vid1 (f0 fid1)) (a, b) (?sol r))
(mk_xode I (OSing vid1 (f0 fid1)) (?sol r)) (semBV I (OSing vid1 (f0 fid1)))"
using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(a,b)" "(?sol r)"] by auto
have prereq1a:"fst ?abba
= fst (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
using agrees aaba
apply (auto simp add: aaba Vagree_def)
apply (rule vec_extensionality)
subgoal for i
apply (cases "i = vid1")
using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def)
done
apply (rule vec_extensionality)
subgoal for i
apply (cases "i = vid1")
apply(auto simp add: f0_def empty_def)
done
done
have prereq1b:"snd (?abba) = snd (mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))"
using agrees aaba
apply (auto simp add: aaba Vagree_def)
apply (rule vec_extensionality)
subgoal for i
apply (cases "i = vid1")
using vne12 agrees Vagree_def apply (auto simp add: aaba f0_def empty_def )
done
done
have "?abba = mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r)"
using prod_eq_iff prereq1a prereq1b by blast
hence req1:"((a, b), ?abba) = ((a, b), mk_v I (OSing vid1 (f0 fid1)) (a,b) (?sol r))" by auto
have "sterm_sem I ($f fid1 (λi. Const 0)) b = Functions I fid1 (χ i. 0)" by auto
hence vec_simp:"(λa b. χ i. if i = vid1 then sterm_sem I ($f fid1 (λi. Const 0)) b else 0)
= (λa b. χ i. if i = vid1 then Functions I fid1 (χ i. 0) else 0)"
by (auto simp add: vec_eq_iff cong: if_cong)
have sub: "{0..r} ⊆ UNIV" by auto
have sub2:"{x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x ∈ fml_sem I (p1 vid2 vid1)} ⊆ UNIV" by auto
have req3:"(?sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..r}
{x. mk_v I (OSing vid1 (f0 fid1)) (a,b) x ∈ fml_sem I (p1 vid2 vid1)}"
apply(auto simp add: f0_def empty_def vec_simp)
apply(rule solves_odeI)
apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
defer
apply (rule ext)
apply (subst scaleR_vec_def)
apply (rule refl)
apply (auto intro!: derivative_eq_intros)
using constraint apply (auto)
subgoal for t
apply(erule allE[where x="t"])
apply(auto simp add: p1_def)
proof -
have eq:"(χ i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
(χ y. if vid3 = y then t else fst (χ y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) =
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (a, b)
(χ i. if i = vid1 then a $ i + Functions I fid1 (χ _. 0) * t else a $ i)))"
using vne12 vne13 mk_v_agree[of "I" "(OSing vid1 ($f fid1 (λi. Const 0)))" "(a, b)" "(χ i. if i = vid1 then a $ i + Functions I fid1 (χ _. 0) * t else a $ i)"]
by (auto simp add: vec_eq_iff f0_def empty_def Vagree_def)
show "0 ≤ t ⟹
t ≤ r ⟹
Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
(χ y. if vid3 = y then t else fst (χ y. if vid2 = y then r else fst (a, b) $ y, b) $ y, b)) ⟹
Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (a, b)
(χ i. if i = vid1 then a $ i + Functions I fid1 (χ _. 0) * t else a $ i)))"
using eq by auto
qed
done
have req4':"?sol 0 = fst (a,b)" by (auto simp: vec_eq_iff)
then have req4: " (?sol 0) = (fst (a,b))"
using VSagree_refl[of a] req4' unfolding VSagree_def by auto
have inPred:"?abba ∈ fml_sem I (p1 vid3 vid1)"
using req1 leq req3 req4 thisW by fastforce
have sem_eq:"?abba ∈ fml_sem I (p1 vid3 vid1) ⟷ (aa,ba) ∈ fml_sem I (p1 vid3 vid1)"
apply (rule coincidence_formula)
apply (auto simp add: aaba Vagree_def p1_def f0_def empty_def)
subgoal using Iagree_refl by auto
done
from inPred sem_eq have inPred':"(aa,ba) ∈ fml_sem I (p1 vid3 vid1)"
by auto
show "repv (repv (a, b) vid2 r) vid1
(dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (a, b) vid2 r))
∈ fml_sem I (p1 vid3 vid1)"
using aaba inPred' by (auto)
next
fix I::"('sf,'sc,'sz) interp"
and aa ba ab bb sol
and t:: real
assume good_interp:"is_interp I"
assume all:"
∀r. dterm_sem I (Const 0) (repv (ab, bb) vid2 r) ≤ dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 r) ⟶
(∀ra. repv (repv (ab, bb) vid2 r) vid3 ra
∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
{v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
Predicates I vid2
(χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
(repv (repv (ab, bb) vid2 r) vid3 ra))) ⟶
(∀ω. ω = repv (repv (ab, bb) vid2 r) vid1
(dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 r)) ⟶
ω ∈ fml_sem I (p1 vid3 vid1))"
assume t:"0 ≤ t"
assume aaba:"(aa, ba) = mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t)"
assume sol:"(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
{x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
hence constraint:"⋀s. s ∈ {0 .. t} ⟹ sol s ∈ {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
using solves_ode_domainD by fastforce
assume sol0:" (sol 0) = (fst (ab, bb)) "
have impl:"dterm_sem I (Const 0) (repv (ab, bb) vid2 t) ≤ dterm_sem I (trm.Var vid2) (repv (ab, bb) vid2 t) ⟶
(∀ra. repv (repv (ab, bb) vid2 t) vid3 ra
∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
{v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
Predicates I vid2
(χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
(repv (repv (ab, bb) vid2 t) vid3 ra))) ⟶
(∀ω. ω = repv (repv (ab, bb) vid2 t) vid1
(dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) ⟶
ω ∈ fml_sem I (p1 vid3 vid1))" using all by auto
interpret ll:ll_on_open_it UNIV "(λ_. ODE_sem I (OSing vid1 (f0 fid1)))" "UNIV" 0
apply(standard)
apply(auto)
unfolding local_lipschitz_def f0_def empty_def sterm_sem.simps
using gt_ex lipschitz_on_constant by blast
have eq_UNIV:"ll.existence_ivl 0 (sol 0) = UNIV"
apply(rule ll.existence_ivl_eq_domain)
apply(auto)
subgoal for tm tM t
apply(unfold f0_def empty_def sterm_sem.simps)
by(metis add.right_neutral mult_zero_left order_refl)
done
let ?f = "(λ_. ODE_sem I (OSing vid1 (f0 fid1)))"
have sol_UNIV: "⋀t x. (ll.flow 0 x usolves_ode ?f from 0) (ll.existence_ivl 0 x) UNIV"
using ll.flow_usolves_ode by auto
from sol have sol':
"(sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t} UNIV"
apply (rule solves_ode_supset_range)
by auto
from sol' have sol'':"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ (sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
by (simp add: solves_ode_subset)
have sol0_eq:"sol 0 = ll.flow 0 (sol 0) 0"
using ll.general.flow_initial_time_if by auto
have isFlow:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ sol s = ll.flow 0 (sol 0) s"
apply(rule ll.equals_flowI)
apply(auto)
subgoal using eq_UNIV by auto
subgoal using sol'' closed_segment_eq_real_ivl t by (auto simp add: solves_ode_singleton)
subgoal using eq_UNIV sol sol0_eq by auto
done
let ?c = "Functions I fid1 (χ _. 0)"
let ?sol = "(λt. χ i. if i = vid1 then (ab $ i) + ?c * t else (ab $ i))"
have vec_simp:"(λa b. χ i. if i = vid1 then sterm_sem I ($f fid1 (λi. Const 0)) b else 0)
= (λa b. χ i. if i = vid1 then Functions I fid1 (χ i. 0) else 0)"
by (auto simp add: vec_eq_iff cong: if_cong)
have exp_sol:"(?sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..t}
UNIV"
apply(auto simp add: f0_def empty_def vec_simp)
apply(rule solves_odeI)
apply(auto simp only: has_vderiv_on_def has_vector_derivative_def box_sem)
apply (rule has_derivative_vec[THEN has_derivative_eq_rhs])
defer
apply (rule ext)
apply (subst scaleR_vec_def)
apply (rule refl)
apply (auto intro!: derivative_eq_intros)
done
from exp_sol have exp_sol':"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ (?sol solves_ode (λ_. ODE_sem I (OSing vid1 (f0 fid1)))) {0..s} UNIV"
by (simp add: solves_ode_subset)
have exp_sol0_eq:"?sol 0 = ll.flow 0 (?sol 0) 0"
using ll.general.flow_initial_time_if by auto
have more_eq:"(χ i. if i = vid1 then ab $ i + Functions I fid1 (χ _. 0) * 0 else ab $ i) = sol 0"
using sol0
apply auto
apply(rule vec_extensionality)
by(auto)
have exp_isFlow:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ ?sol s = ll.flow 0 (sol 0) s"
apply(rule ll.equals_flowI)
apply(auto)
subgoal using eq_UNIV by auto
defer
subgoal for s
using eq_UNIV apply auto
subgoal using exp_sol exp_sol0_eq more_eq
apply(auto)
done
done
using exp_sol' closed_segment_eq_real_ivl t apply(auto)
by (simp add: solves_ode_singleton)
have sol_eq_exp:"⋀s. s ≥ 0 ⟹ s ≤ t ⟹ ?sol s = sol s"
unfolding exp_isFlow isFlow by auto
then have sol_eq_exp_t:"?sol t = sol t"
using t by auto
then have sol_eq_exp_t':"sol t $ vid1 = ?sol t $ vid1" by auto
then have useful:"?sol t $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * t"
by auto
from sol_eq_exp_t' useful have useful':"sol t $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * t"
by auto
have sol_int:"((ll.flow 0 (sol 0)) usolves_ode ?f from 0) {0..t} {x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"
apply (rule usolves_ode_subset_range[of "(ll.flow 0 (sol 0))" "?f" "0" "{0..t}" "UNIV" "{x. mk_v I (OSing vid1 (f0 fid1)) (ab, bb) x ∈ fml_sem I (p1 vid2 vid1)}"])
subgoal using eq_UNIV sol_UNIV[of "(sol 0)"] apply (auto)
apply (rule usolves_ode_subset)
using t by(auto)
apply(auto)
using sol apply(auto dest!: solves_ode_domainD)
subgoal for xa using isFlow[of xa] by(auto)
done
have thing:"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ fst (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (?sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * s"
subgoal for s
using mk_v_agree[of I "(OSing vid1 ($f fid1 (λi. Const 0)))" "(ab, bb)" "(?sol s)"] apply auto
unfolding Vagree_def by auto
done
have thing':"⋀s. 0 ≤ s ⟹ s ≤ t ⟹ fst (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (sol s)) $ vid1 = ab $ vid1 + Functions I fid1 (χ i. 0) * s"
subgoal for s using thing[of s] sol_eq_exp[of s] by auto done
have another_eq:"⋀i s. 0 ≤ s ⟹ s ≤ t ⟹ dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol s))
= dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
(χ y. if vid3 = y then s else fst (χ y. if vid2 = y then s else fst (ab, bb) $ y, bb) $ y, bb)"
using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol s)"] vne12 vne23 vne13
apply(auto simp add: f0_def p1_def empty_def)
unfolding Vagree_def apply(simp add: f0_def empty_def)
subgoal for s using thing' by auto
done
have allRa':"(∀ra. repv (repv (ab, bb) vid2 t) vid3 ra
∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
{v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol ra))))"
apply(rule allI)
subgoal for ra
using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
done
done
have anotherFact:"⋀ra. 0 ≤ ra ⟹ ra ≤ t ⟹ (χ i. if i = vid1 then ab $ i + Functions I fid1 (χ _. 0) * ra else ab $ i) $ vid1 =
ab $ vid1 + dterm_sem I (f0 fid1) (χ y. if vid3 = y then ra else fst (χ y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) * ra "
subgoal for ra
apply simp
apply(rule disjI2)
by (auto simp add: f0_def empty_def)
done
have thing':"⋀ra i. 0 ≤ ra ⟹ ra ≤ t ⟹ dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (sol ra))
= dterm_sem I (if i = vid1 then Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3)) else Const 0)
(χ y. if vid3 = y then ra else fst (χ y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y, bb) "
subgoal for ra i
using vne12 vne13 mk_v_agree[of I "OSing vid1 ($f fid1 (λi. Const 0))" "(ab,bb)" "(sol ra)"]
apply (auto)
unfolding Vagree_def apply(safe)
apply(erule allE[where x="vid1"])+
using sol_eq_exp[of ra] anotherFact[of ra] by auto
done
have allRa:"(∀ra. repv (repv (ab, bb) vid2 t) vid3 ra
∈ {v. dterm_sem I (Const 0) v ≤ dterm_sem I (trm.Var vid3) v} ∩
{v. dterm_sem I (trm.Var vid3) v ≤ dterm_sem I (trm.Var vid2) v} ⟶
Predicates I vid2
(χ i. dterm_sem I (singleton (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid3))) i)
(repv (repv (ab, bb) vid2 t) vid3 ra)))"
apply(rule allI)
subgoal for ra
using mk_v_agree[of "I" "(OSing vid1 (f0 fid1))" "(ab, bb)" "(sol ra)"]
vne23 constraint[of ra] apply(auto simp add: Vagree_def p1_def)
using sol_eq_exp[of ra] apply (auto simp add: f0_def empty_def Vagree_def vec_eq_iff)
using thing' by auto
done
have fml3:"⋀ra. 0 ≤ ra ⟹ ra ≤ t ⟹
(∀ω. ω = repv (repv (ab, bb) vid2 t) vid1
(dterm_sem I (Plus (trm.Var vid1) (Times (f0 fid1) (trm.Var vid2))) (repv (ab, bb) vid2 t)) ⟶
ω ∈ fml_sem I (p1 vid3 vid1))"
using impl allRa by auto
have someEq:"(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(χ y. if vid1 = y then (if vid2 = vid1 then t else fst (ab, bb) $ vid1) + Functions I fid1 (χ i. 0) * t
else fst (χ y. if vid2 = y then t else fst (ab, bb) $ y, bb) $ y,
bb))
= (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. Const 0))) (ab, bb) (sol t)))"
apply(rule vec_extensionality)
using vne12 sol_eq_exp t thing by auto
show "mk_v I (OSing vid1 (f0 fid1)) (ab, bb) (sol t) ∈ fml_sem I (p1 vid3 vid1)"
using mk_v_agree[of I "OSing vid1 (f0 fid1)" "(ab, bb)" "sol t"] fml3[of t]
unfolding f0_def p1_def empty_def Vagree_def
using someEq by(auto simp add: sol_eq_exp_t' t vec_extensionality vne12)
qed qed
lemma MVT0_within:
fixes f ::"real ⇒ real"
and f'::"real ⇒ real ⇒ real"
and s t :: real
assumes f':"⋀x. x ∈ {0..t} ⟹ (f has_derivative (f' x)) (at x within {0..t})"
assumes geq':"⋀x. x ∈ {0..t} ⟹ f' x s ≥ 0"
assumes int_s:"s > 0 ∧ s ≤ t"
assumes t: "0 < t"
shows "f s ≥ f 0"
proof -
have "f 0 + 0 ≤ f s"
apply (rule Lib.MVT_ivl'[OF f', of 0 s 0])
subgoal for x by assumption
subgoal for x using geq' by auto
using t int_s t apply auto
subgoal for x
by (metis int_s mult.commute mult.right_neutral order.trans mult_le_cancel_iff2)
done
then show "?thesis" by auto
qed
lemma MVT':
fixes f g ::"real ⇒ real"
fixes f' g'::"real ⇒ real ⇒ real"
fixes s t ::real
assumes f':"⋀s. s ∈ {0..t} ⟹ (f has_derivative (f' s)) (at s within {0..t})"
assumes g':"⋀s. s ∈ {0..t} ⟹ (g has_derivative (g' s)) (at s within {0..t})"
assumes geq':"⋀x. x ∈ {0..t} ⟹ f' x s ≥ g' x s"
assumes geq0:"f 0 ≥ g 0"
assumes int_s:"s > 0 ∧ s ≤ t"
assumes t:"t > 0"
shows "f s ≥ g s"
proof -
let ?h = "(λx. f x - g x)"
let ?h' = "(λs x. f' s x - g' s x)"
have "?h s ≥ ?h 0"
apply(rule MVT0_within[of t ?h "?h'" s])
subgoal for s using f'[of s] g'[of s] by auto
subgoal for sa using geq'[of sa] by auto
subgoal using int_s by auto
subgoal using t by auto
done
then show "?thesis" using geq0 by auto
qed
lemma MVT'_gr:
fixes f g ::"real ⇒ real"
fixes f' g'::"real ⇒ real ⇒ real"
fixes s t ::real
assumes f':"⋀s. s ∈ {0..t} ⟹ (f has_derivative (f' s)) (at s within {0..t})"
assumes g':"⋀s. s ∈ {0..t} ⟹ (g has_derivative (g' s)) (at s within {0..t})"
assumes geq':"⋀x. x ∈ {0..t} ⟹ f' x s ≥ g' x s"
assumes geq0:"f 0 > g 0"
assumes int_s:"s > 0 ∧ s ≤ t"
assumes t:"t > 0"
shows "f s > g s"
proof -
let ?h = "(λx. f x - g x)"
let ?h' = "(λs x. f' s x - g' s x)"
have "?h s ≥ ?h 0"
apply(rule MVT0_within[of t ?h "?h'" s])
subgoal for s using f'[of s] g'[of s] by auto
subgoal for sa using geq'[of sa] by auto
subgoal using int_s by auto
subgoal using t by auto
done
then show "?thesis" using geq0 by auto
qed
lemma frech_linear:
fixes x θ ν ν' I
assumes good_interp:"is_interp I"
assumes free:"dfree θ"
shows "x * frechet I θ ν ν' = frechet I θ ν (x *⇩R ν')"
using frechet_linear[OF good_interp free]
by (simp add: linear_simps)
lemma rift_in_space_time:
fixes sol I ODE ψ θ t s b
assumes good_interp:"is_interp I"
assumes free:"dfree θ"
assumes osafe:"osafe ODE"
assumes sol:"(sol solves_ode (λ_ ν'. ODE_sem I ODE ν')) {0..t}
{x. mk_v I ODE (sol 0, b) x ∈ fml_sem I ψ}"
assumes FVT:"FVT θ ⊆ semBV I ODE"
assumes ivl:"s ∈ {0..t}"
shows "((λt. sterm_sem I θ (fst (mk_v I ODE (sol 0, b) (sol t))))
has_derivative (λt'. t' * frechet I θ (fst((mk_v I ODE (sol 0, b) (sol s)))) (snd (mk_v I ODE (sol 0, b) (sol s))))) (at s within {0..t})"
proof -
let ?φ = "(λt. (mk_v I ODE (sol 0, b) (sol t)))"
let ?φs = "(λt. fst (?φ t))"
have sol_deriv:"⋀s. s ∈ {0..t} ⟹ (sol has_derivative (λxa. xa *⇩R ODE_sem I ODE (sol s))) (at s within {0..t})"
using sol apply simp
apply (drule solves_odeD(1))
unfolding has_vderiv_on_def has_vector_derivative_def
by auto
have sol_dom:"⋀s. s∈ {0..t} ⟹ ?φ s ∈ fml_sem I ψ"
using sol apply simp
apply (drule solves_odeD(2))
by auto
let ?h = "(λt. sterm_sem I θ (?φs t))"
let ?g = "(λν. sterm_sem I θ ν)"
let ?f = "?φs"
let ?f' = "(λt'. t' *⇩R (χ i. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
let ?g' = "(frechet I θ (?φs s))"
have heq:"?h = ?g ∘ ?f" by (auto)
have fact1:"⋀i. i ∈ ODE_vars I ODE ⟹ (λt. ?φs(t) $ i) = (λt. sol t $ i)"
subgoal for i
apply(rule ext)
subgoal for t
using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
unfolding Vagree_def by auto
done done
have fact2:"⋀i. i ∈ ODE_vars I ODE ⟹ (λt. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (λt. ODE_sem I ODE (sol t) $ i)"
subgoal for i
apply(rule ext)
subgoal for t
using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
unfolding Vagree_def by auto
done done
have fact3:"⋀i. i ∈ (-ODE_vars I ODE) ⟹ (λt. ?φs(t) $ i) = (λt. sol 0 $ i)"
subgoal for i
apply(rule ext)
subgoal for t
using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
unfolding Vagree_def by auto
done done
have fact4:"⋀i. i ∈ (-ODE_vars I ODE) ⟹ (λt. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol t) $ i else 0) = (λt. 0)"
subgoal for i
apply(rule ext)
subgoal for t
using mk_v_agree[of I ODE "(sol 0, b)" "sol t"]
unfolding Vagree_def by auto
done done
have some_eq:"(λv'. χ i. v' *⇩R ODE_sem I ODE (sol s) $ i) = (λv'. v' *⇩R ODE_sem I ODE (sol s))"
apply(rule ext)
apply(rule vec_extensionality)
by auto
have some_sol:"(sol has_derivative (λv'. v' *⇩R ODE_sem I ODE (sol s))) (at s within {0..t})"
using sol ivl unfolding solves_ode_def has_vderiv_on_def has_vector_derivative_def by auto
have some_eta:"(λt. χ i. sol t $ i) = sol" by (rule ext, rule vec_extensionality, auto)
have ode_deriv:"⋀i. i ∈ ODE_vars I ODE ⟹
((λt. sol t $ i) has_derivative (λ v'. v' *⇩R ODE_sem I ODE (sol s) $ i)) (at s within {0..t})"
subgoal for i
apply(rule has_derivative_proj)
using some_eq some_sol some_eta by auto
done
have eta:"(λt. (χ i. ?f t $ i)) = ?f" by(rule ext, rule vec_extensionality, auto)
have eta_esque:"(λt'. χ i. t' * (if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)) =
(λt'. t' *⇩R (χ i. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0))"
apply(rule ext | rule vec_extensionality)+
subgoal for t' i by auto done
have "((λt. (χ i. ?f t $ i)) has_derivative (λt'. (χ i. ?f' t' $ i))) (at s within {0..t})"
apply (rule has_derivative_vec)
subgoal for i
apply(cases "i ∈ ODE_vars I ODE")
subgoal using fact1[of i] fact2[of i] ode_deriv[of i] by auto
subgoal using fact3[of i] fact4[of i] by auto
done
done
then have fderiv:"(?f has_derivative ?f') (at s within {0..t})" using eta eta_esque by auto
have gderiv:"(?g has_derivative ?g') (at (?f s) within ?f ` {0..t})"
using has_derivative_at_withinI
using frechet_correctness free good_interp
by blast
have chain:"((?g ∘ ?f) has_derivative (?g' ∘ ?f')) (at s within {0..t})"
using fderiv gderiv diff_chain_within by blast
let ?coν1 = "(fst (mk_v I ODE (sol 0, b) (sol s)), ODE_sem I ODE (fst (mk_v I ODE (sol 0, b) (sol s))))"
let ?coν2 = "(fst (mk_v I ODE (sol 0, b) (sol s)), snd (mk_v I ODE (sol 0, b) (sol s)))"
have sub_cont:"⋀a .a ∉ ODE_vars I ODE ⟹ Inl a ∈ FVT θ ⟹ False"
using FVT by auto
have sub_cont2:"⋀a .a ∉ ODE_vars I ODE ⟹ Inr a ∈ FVT θ ⟹ False"
using FVT by auto
have "Vagree (mk_v I ODE (sol 0, b) (sol s)) (sol s, b) (Inl ` ODE_vars I ODE)"
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
unfolding Vagree_def by auto
let ?co'ν1 = "(λx. (fst (mk_v I ODE (sol 0, b) (sol s)), x *⇩R (χ i. if i ∈ ODE_vars I ODE then ODE_sem I ODE (sol s) $ i else 0)))"
let ?co'ν2 = "(λx. (fst (mk_v I ODE (sol 0, b) (sol s)), x *⇩R snd (mk_v I ODE (sol 0, b) (sol s))))"
have co_agree_sem:"⋀s. Vagree (?co'ν1 s) (?co'ν2 s) (semBV I ODE)"
subgoal for sa
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
unfolding Vagree_def by auto
done
have co_agree_help:"⋀s. Vagree (?co'ν1 s) (?co'ν2 s) (FVT θ)"
using agree_sub[OF FVT co_agree_sem] by auto
have co_agree':"⋀s. Vagree (?co'ν1 s) (?co'ν2 s) (FVDiff θ)"
subgoal for s
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
unfolding Vagree_def apply auto
subgoal for i x
apply(cases x)
subgoal for a
apply(cases "a ∈ ODE_vars I ODE")
by (simp | metis (no_types, lifting) FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
subgoal for a
apply(cases "a ∈ ODE_vars I ODE")
by (simp | metis (no_types, lifting) FVT Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv)+
done
subgoal for i x
apply(cases x)
subgoal for a
apply(cases "a ∈ ODE_vars I ODE")
using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
by auto
subgoal for a
apply(cases "a ∈ ODE_vars I ODE")
apply(erule allE[where x=i])+
using FVT ODE_vars_lr Vagree_def mk_v_agree mk_xode.elims subsetD snd_conv
by auto
done
done
done
have heq'':"(?g' ∘ ?f') = (λt'. t' *⇩R frechet I θ (?φs s) (snd (?φ s)))"
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"]
unfolding comp_def
apply auto
apply(rule ext | rule vec_extensionality)+
subgoal for x
using frech_linear[of I θ x "(fst (mk_v I ODE (sol 0, b) (sol s)))" "(snd (mk_v I ODE (sol 0, b) (sol s)))", OF good_interp free]
using coincidence_frechet[OF free, of "(?co'ν1 x)" "(?co'ν2 x)", OF co_agree'[of x], of I]
by auto
done
have "((?g ∘ ?f) has_derivative (?g' ∘ ?f')) (at s within {0..t})"
using chain by auto
then have "((?g ∘ ?f) has_derivative (λt'. t' * frechet I θ (?φs s) (snd (?φ s)))) (at s within {0..t})"
using heq'' by auto
then have result:"((λt. sterm_sem I θ (?φs t)) has_derivative (λt. t * frechet I θ (?φs s) (snd (?φ s)))) (at s within {0..t})"
using heq by auto
then show "?thesis" by auto
qed
lemma dterm_sterm_dfree:
"dfree θ ⟹ (⋀ν ν'. sterm_sem I θ ν = dterm_sem I θ (ν, ν'))"
by(induction rule: dfree.induct, auto)
lemma DIGeq_valid:"valid DIGeqaxiom"
unfolding DIGeqaxiom_def
apply(unfold DIGeqaxiom_def valid_def impl_sem iff_sem)
apply(auto)
proof -
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume t:"0 ≤ t"
and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"] by auto
then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
unfolding Vagree_def by (auto simp add: empty_def)
show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t)) ≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
using notin incon by auto
next
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume t:"0 ≤ t"
and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"] by auto
then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
unfolding Vagree_def by (auto simp add: empty_def)
show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t)) ≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
using notin incon by auto
next
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
assume notin:"¬ Predicates I vid1 (χ i. dterm_sem I (local.empty i) (sol 0, b))"
have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"] by auto
then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
unfolding Vagree_def by (auto simp add: empty_def)
show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
using incon notin by auto
next
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume good_interp:"is_interp I"
assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
assume box:"∀a ba. (∃sola. sol 0 = sola 0 ∧
(∃t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) ∧
0 ≤ t ∧
(sola solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) ⟶
directional_derivative I (f1 fid2 vid1) (a, ba) ≤ directional_derivative I (f1 fid1 vid1) (a, ba)"
assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) ≤ dterm_sem I (f1 fid1 vid1) (sol 0, b)"
have free1:"dfree ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
by (auto intro: dfree.intros)
have free2:"dfree ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
by (auto intro: dfree.intros)
from geq0
have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) ≤ sterm_sem I (f1 fid1 vid1) (sol 0)"
unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b]
by auto
let ?φs = "λx. fst (?φ x)"
let ?φt = "λx. snd (?φ x)"
let ?df1 = "(λt. dterm_sem I (f1 fid2 vid1) (?φ t))"
let ?f1 = "(λt. sterm_sem I (f1 fid2 vid1) (?φs t))"
let ?f1' = "(λ s t'. t' * frechet I (f1 fid2 vid1) (?φs s) (?φt s))"
have dfeq:"?df1 = ?f1"
apply(rule ext)
subgoal for t
using dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"] unfolding f1_def expand_singleton by auto
done
have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
let ?df2 = "(λt. dterm_sem I (f1 fid1 vid1) (?φ t))"
let ?f2 = "(λt. sterm_sem I (f1 fid1 vid1) (?φs t))"
let ?f2' = "(λs t' . t' * frechet I (f1 fid1 vid1) (?φs s) (?φt s))"
let ?int = "{0..t}"
have bluh:"⋀x i. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
using good_interp unfolding is_interp_def by auto
have blah:"(Functions I fid2 has_derivative (THE f'. ∀x. (Functions I fid2 has_derivative f' x) (at x)) (χ i. if i = vid1 then sol t $ vid1 else 0)) (at (χ i. if i = vid1 then sol t $ vid1 else 0))"
using bluh by auto
have bigEx:"⋀s. s ∈ {0..t} ⟹(∃sola. sol 0 = sola 0 ∧
(∃ta. (fst (?φ s),
snd (?φ s)) =
mk_v I (OVar vid1) (sola 0, b) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODEs I vid1)) {0..ta}
{x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
subgoal for s
apply(rule exI[where x=sol])
apply(rule conjI)
subgoal by (rule refl)
apply(rule exI[where x=s])
apply(rule conjI)
subgoal by auto
apply(rule conjI)
subgoal by auto
using sol
using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
by (metis (no_types, lifting) subsetI)
done
have box':"⋀s. s ∈ {0..t} ⟹ directional_derivative I (f1 fid2 vid1) (?φs s, ?φt s)
≤ directional_derivative I (f1 fid1 vid1) (?φs s, ?φt s)"
subgoal for s
using box
apply simp
apply (erule allE[where x="?φs s"])
apply (erule allE[where x="?φt s"])
using bigEx[of s] by auto
done
have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
have agree1:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid2 vid1))"
using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
unfolding f1_def Vagree_def expand_singleton
apply auto
by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
have agree2:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid1 vid1))"
using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
unfolding f1_def Vagree_def expand_singleton
apply auto
by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?φ 0)"
using coincidence_dterm[OF dsafe1 agree1] by auto
then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?φs 0)"
using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
dterm_sterm_dfree[OF free1, of I "(?φs 0)" "snd (?φ 0)"]
unfolding f1_def expand_singleton by auto
have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?φ 0)"
using coincidence_dterm[OF dsafe2 agree2] by auto
then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?φs 0)"
using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?φs 0)" "snd (?φ 0)"]
unfolding f1_def expand_singleton by auto
have good_interp':"⋀i x. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
using good_interp unfolding is_interp_def by auto
have chain :
"⋀f f' g g' x s.
(f has_derivative f') (at x within s) ⟹
(g has_derivative g') (at (f x) within f ` s) ⟹ (g ∘ f has_derivative g' ∘ f') (at x within s)"
by(auto intro: derivative_intros)
have sol1:"(sol solves_ode (λ_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x ∈ fml_sem I (Prop vid1 empty)}"
using sol unfolding p1_def singleton_def empty_def by auto
have FVTsub1:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
apply auto
subgoal for x xa
apply(cases "xa = vid1")
by auto
done
have FVTsub2:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
apply auto
subgoal for x xa
apply(cases "xa = vid1")
by auto
done
have osafe:"osafe (OVar vid1)"
by auto
have deriv1:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f1 has_derivative (?f1' s)) (at s within {0..t})"
subgoal for s
using rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
unfolding f1_def expand_singleton directional_derivative_def
by blast
done
have deriv2:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f2 has_derivative (?f2' s)) (at s within {0..t})"
subgoal for s
using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s]
unfolding f1_def expand_singleton directional_derivative_def
by blast
done
have leq:"⋀s . s ∈ ?int ⟹ ?f1' s 1 ≤ ?f2' s 1"
subgoal for s using box'[of s]
by (simp add: directional_derivative_def)
done
have preserve_agree1:"vid1 ∉ ODE_vars I (OVar vid1) ⟹ VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
unfolding Vagree_def VSagree_def
by auto
have preserve_coincide1:
"vid1 ∉ ODE_vars I (OVar vid1) ⟹
sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
= sterm_sem I (f1 fid2 vid1) (sol 0)"
using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
have preserve_coincide2:
"vid1 ∉ ODE_vars I (OVar vid1) ⟹
sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
= sterm_sem I (f1 fid1 vid1) (sol 0)"
using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
have "?f1 t ≤ ?f2 t"
apply(cases "t = 0")
subgoal using geq0' sem_eq1' sem_eq2' by auto
subgoal
apply(cases "vid1 ∈ ODE_vars I (OVar vid1)")
subgoal
apply (rule MVT'[OF deriv2 deriv1, of t])
subgoal by auto
subgoal by auto
subgoal for s using deriv2[of s] using leq by auto
using t leq geq0' sem_eq1' sem_eq2' by auto
subgoal
using geq0
using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
using preserve_coincide1 preserve_coincide2
by(simp add: f1_def)
done
done
then
show " dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
≤ dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
"
using t
dterm_sterm_dfree[OF free2, of I "?φs t" "snd (?φ t)"]
dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"]
by (simp add: f1_def)
qed
lemma DIGr_valid:"valid DIGraxiom"
unfolding DIGraxiom_def
apply(unfold DIGraxiom_def valid_def impl_sem iff_sem)
apply(auto)
proof -
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume t:"0 ≤ t"
and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"] by auto
then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
unfolding Vagree_def by (auto simp add: empty_def)
show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
using notin incon by auto
next
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume t:"0 ≤ t"
and sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (empty i) (mk_v I ?ODE (sol 0, b) x))}"
and notin:" ¬(Predicates I vid1 (χ i. dterm_sem I (empty i) (sol 0, b)))"
have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"] by auto
then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
unfolding Vagree_def by (auto simp add: empty_def)
show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t)) < dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
using notin incon by auto
next
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
assume notin:"¬ Predicates I vid1 (χ i. dterm_sem I (local.empty i) (sol 0, b))"
have fsafe:"fsafe (Prop vid1 empty)" by (auto simp add: empty_def)
from sol have "Predicates I vid1 (χ i. dterm_sem I (empty i) (?φ 0))"
using t solves_ode_domainD[of sol "(λa. ODEs I vid1)" "{0..t}"] by auto
then have incon:"Predicates I vid1 (χ i. dterm_sem I (empty i) ((sol 0, b)))"
using coincidence_formula[OF fsafe Iagree_refl[of I], of "(sol 0, b)" "?φ 0"]
unfolding Vagree_def by (auto simp add: empty_def)
show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
< dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
using incon notin by auto
next
fix I::"('sf,'sc,'sz) interp" and b aa ba
and sol::"real ⇒ 'sz simple_state"
and t::real
let ?ODE = "OVar vid1"
let ?φ = "(λt. mk_v I (?ODE) (sol 0, b) (sol t))"
assume good_interp:"is_interp I"
assume aaba:"(aa, ba) = mk_v I (OVar vid1) (sol 0, b) (sol t)"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}"
assume box:"∀a ba. (∃sola. sol 0 = sola 0 ∧
(∃t. (a, ba) = mk_v I (OVar vid1) (sola 0, b) (sola t) ∧
0 ≤ t ∧
(sola solves_ode (λa. ODEs I vid1)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sola 0, b) x))})) ⟶
directional_derivative I (f1 fid2 vid1) (a, ba) ≤ directional_derivative I (f1 fid1 vid1) (a, ba)"
assume geq0:"dterm_sem I (f1 fid2 vid1) (sol 0, b) < dterm_sem I (f1 fid1 vid1) (sol 0, b)"
have free1:"dfree ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
by (auto intro: dfree.intros)
have free2:"dfree ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
by (auto intro: dfree.intros)
from geq0
have geq0':"sterm_sem I (f1 fid2 vid1) (sol 0) < sterm_sem I (f1 fid1 vid1) (sol 0)"
unfolding f1_def using dterm_sterm_dfree[OF free1, of I "sol 0" b] dterm_sterm_dfree[OF free2, of I "sol 0" b]
by auto
let ?φs = "λx. fst (?φ x)"
let ?φt = "λx. snd (?φ x)"
let ?df1 = "(λt. dterm_sem I (f1 fid2 vid1) (?φ t))"
let ?f1 = "(λt. sterm_sem I (f1 fid2 vid1) (?φs t))"
let ?f1' = "(λ s t'. t' * frechet I (f1 fid2 vid1) (?φs s) (?φt s))"
have dfeq:"?df1 = ?f1"
apply(rule ext)
subgoal for t
using dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"] unfolding f1_def expand_singleton by auto
done
have free3:"dfree (f1 fid2 vid1)" unfolding f1_def by (auto intro: dfree.intros)
let ?df2 = "(λt. dterm_sem I (f1 fid1 vid1) (?φ t))"
let ?f2 = "(λt. sterm_sem I (f1 fid1 vid1) (?φs t))"
let ?f2' = "(λs t' . t' * frechet I (f1 fid1 vid1) (?φs s) (?φt s))"
let ?int = "{0..t}"
have bluh:"⋀x i. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
using good_interp unfolding is_interp_def by auto
have blah:"(Functions I fid2 has_derivative (THE f'. ∀x. (Functions I fid2 has_derivative f' x) (at x)) (χ i. if i = vid1 then sol t $ vid1 else 0)) (at (χ i. if i = vid1 then sol t $ vid1 else 0))"
using bluh by auto
have bigEx:"⋀s. s ∈ {0..t} ⟹(∃sola. sol 0 = sola 0 ∧
(∃ta. (fst (?φ s),
snd (?φ s)) =
mk_v I (OVar vid1) (sola 0, b) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODEs I vid1)) {0..ta}
{x. Predicates I vid1 (χ i. dterm_sem I (local.empty i) (mk_v I (OVar vid1) (sol 0, b) x))}))"
subgoal for s
apply(rule exI[where x=sol])
apply(rule conjI)
subgoal by (rule refl)
apply(rule exI[where x=s])
apply(rule conjI)
subgoal by auto
apply(rule conjI)
subgoal by auto
using sol
using atLeastAtMost_iff atLeastatMost_subset_iff order_refl solves_ode_on_subset
by (metis (no_types, lifting) subsetI)
done
have box':"⋀s. s ∈ {0..t} ⟹ directional_derivative I (f1 fid2 vid1) (?φs s, ?φt s)
≤ directional_derivative I (f1 fid1 vid1) (?φs s, ?φt s)"
subgoal for s
using box
apply simp
apply (erule allE[where x="?φs s"])
apply (erule allE[where x="?φt s"])
using bigEx[of s] by auto
done
have dsafe1:"dsafe (f1 fid2 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
have dsafe2:"dsafe (f1 fid1 vid1)" unfolding f1_def by (auto intro: dsafe.intros)
have agree1:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid2 vid1))"
using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
unfolding f1_def Vagree_def expand_singleton
apply auto
by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
have agree2:"Vagree (sol 0, b) (?φ 0) (FVT (f1 fid1 vid1))"
using mk_v_agree[of I "(OVar vid1)" "(sol 0, b)" "fst (?φ 0)"]
unfolding f1_def Vagree_def expand_singleton
apply auto
by (metis (no_types, lifting) Compl_iff Vagree_def fst_conv mk_v_agree mk_xode.simps semBV.simps)
have sem_eq1:"dterm_sem I (f1 fid2 vid1) (sol 0, b) = dterm_sem I (f1 fid2 vid1) (?φ 0)"
using coincidence_dterm[OF dsafe1 agree1] by auto
then have sem_eq1':"sterm_sem I (f1 fid2 vid1) (sol 0) = sterm_sem I (f1 fid2 vid1) (?φs 0)"
using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
dterm_sterm_dfree[OF free1, of I "(?φs 0)" "snd (?φ 0)"]
unfolding f1_def expand_singleton by auto
have sem_eq2:"dterm_sem I (f1 fid1 vid1) (sol 0, b) = dterm_sem I (f1 fid1 vid1) (?φ 0)"
using coincidence_dterm[OF dsafe2 agree2] by auto
then have sem_eq2':"sterm_sem I (f1 fid1 vid1) (sol 0) = sterm_sem I (f1 fid1 vid1) (?φs 0)"
using dterm_sterm_dfree[OF free2, of I "sol 0" "b"] dterm_sterm_dfree[OF free2, of I "(?φs 0)" "snd (?φ 0)"]
unfolding f1_def expand_singleton by auto
have good_interp':"⋀i x. (Functions I i has_derivative (THE f'. ∀x. (Functions I i has_derivative f' x) (at x)) x) (at x)"
using good_interp unfolding is_interp_def by auto
have chain :
"⋀f f' g g' x s.
(f has_derivative f') (at x within s) ⟹
(g has_derivative g') (at (f x) within f ` s) ⟹ (g ∘ f has_derivative g' ∘ f') (at x within s)"
by(auto intro: derivative_intros)
have sol1:"(sol solves_ode (λ_. ODE_sem I (OVar vid1))) {0..t} {x. mk_v I (OVar vid1) (sol 0, b) x ∈ fml_sem I (Prop vid1 empty)}"
using sol unfolding p1_def singleton_def empty_def by auto
have FVTsub1:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
apply auto
subgoal for x xa
apply(cases "xa = vid1")
by auto
done
have FVTsub2:"vid1 ∈ ODE_vars I (OVar vid1) ⟹ FVT ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) ⊆ semBV I ((OVar vid1))"
apply auto
subgoal for x xa
apply(cases "xa = vid1")
by auto
done
have osafe:"osafe (OVar vid1)"
by auto
have deriv1:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f1 has_derivative (?f1' s)) (at s within {0..t})"
subgoal for s
using rift_in_space_time[OF good_interp free1 osafe sol1 FVTsub1, of s]
unfolding f1_def expand_singleton directional_derivative_def
by blast
done
have deriv2:"⋀s. vid1 ∈ ODE_vars I (OVar vid1) ⟹ s ∈ ?int ⟹ (?f2 has_derivative (?f2' s)) (at s within {0..t})"
subgoal for s
using rift_in_space_time[OF good_interp free2 osafe sol1 FVTsub2, of s]
unfolding f1_def expand_singleton directional_derivative_def
by blast
done
have leq:"⋀s . s ∈ ?int ⟹ ?f1' s 1 ≤ ?f2' s 1"
subgoal for s using box'[of s]
by (simp add: directional_derivative_def)
done
have preserve_agree1:"vid1 ∉ ODE_vars I (OVar vid1) ⟹ VSagree (sol 0) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t))) {vid1}"
using mk_v_agree[of I "OVar vid1" "(sol 0, b)" "sol t"]
unfolding Vagree_def VSagree_def
by auto
have preserve_coincide1:
"vid1 ∉ ODE_vars I (OVar vid1) ⟹
sterm_sem I (f1 fid2 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
= sterm_sem I (f1 fid2 vid1) (sol 0)"
using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid2 vid1" I]
preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
have preserve_coincide2:
"vid1 ∉ ODE_vars I (OVar vid1) ⟹
sterm_sem I (f1 fid1 vid1) (fst (mk_v I (OVar vid1) (sol 0, b) (sol t)))
= sterm_sem I (f1 fid1 vid1) (sol 0)"
using coincidence_sterm[of "(sol 0, b)" "(mk_v I (OVar vid1) (sol 0, b) (sol t))" "f1 fid1 vid1" I]
preserve_agree1 unfolding VSagree_def Vagree_def f1_def by auto
have "?f1 t < ?f2 t"
apply(cases "t = 0")
subgoal using geq0' sem_eq1' sem_eq2' by auto
subgoal
apply(cases "vid1 ∈ ODE_vars I (OVar vid1)")
subgoal
apply (rule MVT'_gr[OF deriv2 deriv1, of t])
subgoal by auto
subgoal by auto
subgoal for s using deriv2[of s] using leq by auto
using t leq geq0' sem_eq1' sem_eq2' by auto
subgoal
using geq0
using dterm_sterm_dfree[OF free1, of I "sol 0" "b"]
using dterm_sterm_dfree[OF free2, of I "sol 0" "b"]
using preserve_coincide1 preserve_coincide2
by(simp add: f1_def)
done
done
then
show "dterm_sem I (f1 fid2 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))
< dterm_sem I (f1 fid1 vid1) (mk_v I (OVar vid1) (sol 0, b) (sol t))"
using t
dterm_sterm_dfree[OF free2, of I "?φs t" "snd (?φ t)"]
dterm_sterm_dfree[OF free1, of I "?φs t" "snd (?φ t)"]
using geq0 f1_def
by (simp add: f1_def)
qed
lemma DG_valid:"valid DGaxiom"
proof -
have osafe:"osafe (OSing vid1 (f1 fid1 vid1))"
by(auto simp add: osafe_Sing dfree_Fun dfree_Const f1_def expand_singleton)
have fsafe:"fsafe (p1 vid1 vid1)"
by(auto simp add: p1_def dfree_Const)
have osafe2:"osafe (OProd (OSing vid1 (f1 fid1 vid1)) (OSing vid2 (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))))"
by(auto simp add: f1_def expand_singleton osafe.intros dfree.intros vne12)
note sem = ode_alt_sem[OF osafe fsafe]
note sem2 = ode_alt_sem[OF osafe2 fsafe]
have p2safe:"fsafe (p1 vid2 vid1)" by(auto simp add: p1_def dfree_Const)
show "valid DGaxiom"
apply(auto simp del: prog_sem.simps(8) simp add: DGaxiom_def valid_def sem sem2)
apply(rule exI[where x=0], auto simp add: f1_def p1_def expand_singleton)
subgoal for I a b aa ba sol t
proof -
assume good_interp:"is_interp I"
assume "
∀aa ba. (∃sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) ∧
0 ≤ t ∧
(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} ∧
VSagree (sol 0) a {uu. uu = vid1 ∨
Inl uu ∈ Inl ` {x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∨
(∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
then have
bigAll:"
⋀aa ba. (∃sol t. (aa, ba) = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) ∧
0 ≤ t ∧
(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} ∧
VSagree (sol 0) a {uu. uu = vid1 ∨ (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
by (auto)
assume aaba:"(aa, ba) =
mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)"
assume t:"0 ≤ t"
assume sol:"
(sol solves_ode
(λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
{0..t} {x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) x))}"
assume VSag:"VSagree (sol 0) (χ y. if vid2 = y then 0 else fst (a, b) $ y)
{x. x = vid2 ∨ x = vid1 ∨ x = vid2 ∨ x = vid1 ∨ Inl x ∈ Inl ` {x. x = vid2 ∨ x = vid1} ∨ x = vid1}"
let ?sol = "(λt. χ i. if i = vid1 then sol t $ vid1 else 0)"
let ?aaba' = "mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)"
from bigAll[of "fst ?aaba'" "snd ?aaba'"]
have bigEx:"(∃sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t) ∧
0 ≤ t ∧
(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))} ∧
VSagree (sol 0) a {uu. uu = vid1 ∨ (∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?aaba'))"
by simp
have pre1:"?aaba' = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)"
by (rule refl)
have agreeL:"⋀s. fst (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) $ vid1 = sol s $ vid1"
subgoal for s
using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))" "(χ y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol s)"]
unfolding Vagree_def by auto done
have agreeR:"⋀s. fst (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol s $ vid1 else 0)) $ vid1 = sol s $ vid1"
subgoal for s
using mk_v_agree[of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(χ i. if i = vid1 then sol s $ vid1 else 0)"]
unfolding Vagree_def by auto
done
have FV:"(FVF (p1 vid1 vid1)) = {Inl vid1}" unfolding p1_def expand_singleton
apply auto subgoal for x xa apply(cases "xa = vid1") by auto done
have agree:"⋀s. Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol s)) (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol s $ vid1 else 0)) (FVF (p1 vid1 vid1))"
using agreeR agreeL unfolding Vagree_def FV by auto
note con_sem_eq = coincidence_formula[OF fsafe Iagree_refl agree]
have constraint:"⋀s. 0 ≤ s ∧ s ≤ t ⟹
Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol s $ vid1 else 0)))"
using sol apply simp
apply(drule solves_odeD(2))
apply auto[1]
subgoal for s using con_sem_eq by (auto simp add: p1_def expand_singleton)
done
have eta:"sol = (λt. χ i. sol t $ i)" by (rule ext, rule vec_extensionality, simp)
have yet_another_eq:"⋀x. (λxa. xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)))
= (λxa. (χ i. (xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i))"
subgoal for x by (rule ext, rule vec_extensionality, simp) done
have sol_deriv:"⋀x. x ∈{0..t} ⟹
(sol has_derivative
(λxa. xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))))
(at x within {0..t})"
using sol apply simp
apply(drule solves_odeD(1))
unfolding has_vderiv_on_def has_vector_derivative_def by auto
then have sol_deriv:"⋀x. x ∈ {0..t} ⟹
((λt. χ i. sol t $ i) has_derivative
(λxa. (χ i. (xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0))) $ i)))
(at x within {0..t})" using yet_another_eq eta by auto
have sol_deriv1: "⋀x. x ∈ {0..t} ⟹
((λt. sol t $ vid1) has_derivative
(λxa. (xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol x) else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol x) else 0)) $ vid1)))
(at x within {0..t})"
subgoal for s
apply(rule has_derivative_proj[of "(λ i t. sol t $ i)" "(λj xa. (xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (sol s) else 0)) $ j))" "at s within {0..t}""vid1"])
using sol_deriv[of s] by auto done
have hmm:"⋀s. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (sol s)) = (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (χ i. if i = vid1 then sol s $ vid1 else 0))"
by(rule vec_extensionality, auto)
have aha:"⋀s. (λxa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) = (λxa. xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0))"
subgoal for s
apply(rule ext)
subgoal for xa using hmm by (auto simp add: f1_def) done done
let ?sol' = "(λs. (λxa. χ i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0))"
let ?project_me_plz = "(λt. (χ i. if i = vid1 then ?sol t $ vid1 else 0))"
have sol_deriv_eq:"⋀s. s ∈{0..t} ⟹
((λt. (χ i. if i = vid1 then ?sol t $ vid1 else 0)) has_derivative ?sol' s) (at s within {0..t})"
subgoal for s
apply(rule has_derivative_vec)
subgoal for i
apply (cases "i = vid1", cases "i = vid2", auto)
using vne12 apply simp
using sol_deriv1[of s] using aha by auto
done done
have yup:"(λt. (χ i. if i = vid1 then ?sol t $ vid1 else 0) $ vid1) = (λt. sol t $ vid1)"
by(rule ext, auto)
have maybe:"⋀s. (λxa. xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0)) = (λxa. (χ i. if i = vid1 then xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0) $ vid1) "
by(rule ext, auto)
have almost:"(λx. if vid1 = vid1 then (χ i. if i = vid1 then sol x $ vid1 else 0) $ vid1 else 0) =
(λx. (χ i. if i = vid1 then sol x $ vid1 else 0) $ vid1)" by(rule ext, auto)
have almost':"⋀s. (λh. if vid1 = vid1 then h * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0) = (λh. h * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0))"
by(rule ext, auto)
have deriv':" ⋀x. x ∈ {0..t} ⟹
((λt. χ i. if i = vid1 then sol t $ vid1 else 0) has_derivative
(λxa. (χ i. xa *⇩R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol x $ vid1 else 0) else 0))))
(at x within {0..t})"
subgoal for s
apply(rule has_derivative_vec)
subgoal for i
apply(cases "i = vid1")
prefer 2 subgoal by auto
apply auto
using has_derivative_proj[OF sol_deriv_eq[of s], of vid1] using yup maybe[of s] almost almost'[of s]
by fastforce
done
done
have derEq:"⋀s. (λxa. (χ i. xa *⇩R (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0)))
= (λxa. xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol s $ vid1 else 0) else 0))"
subgoal for s apply (rule ext, rule vec_extensionality) by auto done
have "⋀x. x ∈ {0..t} ⟹
((λt. χ i. if i = vid1 then sol t $ vid1 else 0) has_derivative
(λxa. xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol x $ vid1 else 0) else 0)))
(at x within {0..t})" subgoal for s using deriv'[of s] derEq[of s] by auto done
then have deriv:"((λt. χ i. if i = vid1 then sol t $ vid1 else 0) has_vderiv_on
(λt. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid1 then sol t $ vid1 else 0) else 0))
{0..t}"
unfolding has_vderiv_on_def has_vector_derivative_def
by auto
have pre2:"(?sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
apply(rule solves_odeI)
subgoal by (rule deriv)
subgoal for s using constraint by auto
done
have pre3:"VSagree (?sol 0) a {u. u = vid1 ∨ (∃x. Inl u ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
using vne12 VSag unfolding VSagree_def by simp
have bigPre:"(∃sol t. ?aaba' = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then Var vid1 else Const 0))) (a, b) (sol t) ∧
0 ≤ t ∧
(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then Var vid1 else Const 0))) (a, b) x))} ∧
VSagree (sol 0) a {u. u = vid1 ∨ (∃x. Inl u ∈ FVT (if x = vid1 then Var vid1 else Const 0))})"
apply(rule exI[where x="?sol"])
apply(rule exI[where x=t])
apply(rule conjI)
apply(rule pre1)
apply(rule conjI)
apply(rule t)
apply(rule conjI)
apply(rule pre2)
by(rule pre3)
have pred2:"Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
using bigEx bigPre by auto
then have pred2':"?aaba' ∈ fml_sem I (p1 vid2 vid1)" unfolding p1_def expand_singleton by auto
let ?res_state = "(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))"
have aabaX:"(fst ?aaba') $ vid1 = sol t $ vid1"
using aaba mk_v_agree[of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))"
"(a, b)" "(?sol t)"]
proof -
assume " Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol t $ vid1 else 0))
(a, b) (- semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))) ∧
Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (χ i. if i = vid1 then sol t $ vid1 else 0))
(mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (χ i. if i = vid1 then sol t $ vid1 else 0))
(semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))))"
then have ag:" Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
(mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t))
(semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))))"
by auto
have sembv:"(semBV I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))) = {Inl vid1, Inr vid1}"
by auto
have sub:"{Inl vid1} ⊆ {Inl vid1, Inr vid1}" by auto
have ag':"Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t))
(mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) {Inl vid1}"
using ag agree_sub[OF sub] sembv by auto
then have eq1:"fst (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (?sol t)) $ vid1
= fst (mk_xode I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (?sol t)) $ vid1" unfolding Vagree_def by auto
moreover have "... = sol t $ vid1" by auto
ultimately show ?thesis by auto
qed
have res_stateX:"(fst ?res_state) $ vid1 = sol t $ vid1"
using mk_v_agree[of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))"
"(χ y. if vid2 = y then 0 else fst (a, b) $ y, b)" "(sol t)"]
proof -
assume "Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b)
(- semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))) ∧
Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
(mk_xode I
(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(sol t))
(semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0))))))"
then have ag:" Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
(mk_xode I
(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(sol t))
(semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0))))))" by auto
have sembv:"(semBV I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))) = {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
have sub:"{Inl vid1} ⊆ {Inl vid1, Inr vid1, Inl vid2, Inr vid2}" by auto
have ag':"Vagree (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t))
(mk_xode I
(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(sol t)) {Inl vid1}" using ag sembv agree_sub[OF sub] by auto
then have "fst ?res_state $ vid1 = fst ((mk_xode I
(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(sol t))) $ vid1" unfolding Vagree_def by blast
moreover have "... = sol t $ vid1" by auto
ultimately show "?thesis" by linarith
qed
have agree:"Vagree ?aaba' (?res_state) (FVF (p1 vid2 vid1))"
unfolding p1_def Vagree_def using aabaX res_stateX by auto
have fml_sem_eq:"(?res_state ∈ fml_sem I (p1 vid2 vid1)) = (?aaba' ∈ fml_sem I (p1 vid2 vid1))"
using coincidence_formula[OF p2safe Iagree_refl agree, of I] by auto
then show "Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then 0 else fst (a, b) $ y, b) (sol t)))"
using pred2 unfolding p1_def expand_singleton by auto
qed
subgoal for I a b r aa ba sol t
proof -
assume good_interp:"is_interp I"
assume bigAll:" ∀aa ba. (∃sol t. (aa, ba) =
mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) (sol t) ∧
0 ≤ t ∧
(sol solves_ode
(λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
{0..t} {x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) x))} ∧
VSagree (sol 0) (χ y. if vid2 = y then r else fst (a, b) $ y)
{uu. uu = vid2 ∨
uu = vid1 ∨
uu = vid2 ∨
uu = vid1 ∨
Inl uu
∈ Inl ` ({x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∪
{x. x = vid2 ∨ (∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) ∨
(∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}) ⟶
Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (aa, ba))"
assume aaba:"(aa, ba) = mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t}
{x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) x))}"
assume VSA:"VSagree (sol 0) a
{uu. uu = vid1 ∨
Inl uu ∈ Inl ` {x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∨
(∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))}"
let ?xode = "(λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
let ?xconstraint = UNIV
let ?ivl = "ll_on_open.existence_ivl {0 .. t} ?xode ?xconstraint 0 (sol 0)"
have freef1:"dfree ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
by(auto simp add: dfree_Fun dfree_Const)
have simple_term_inverse':"⋀θ. dfree θ ⟹ raw_term (simple_term θ) = θ"
using simple_term_inverse by auto
have old_lipschitz:"local_lipschitz (UNIV::real set) UNIV (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)"
apply(rule c1_implies_local_lipschitz[where f'="(λ (t,b). blinfun_vec(λ i. if i = vid1 then blin_frechet (good_interp I) (simple_term (Function fid1 (λ i. if i = vid1 then Var vid1 else Const 0))) b else Blinfun(λ _. 0)))"])
apply auto
subgoal for x
apply(rule has_derivative_vec)
subgoal for i
apply(auto simp add: bounded_linear_Blinfun_apply good_interp_inverse good_interp)
apply(auto simp add: simple_term_inverse'[OF freef1])
apply(cases "i = vid1")
apply(auto simp add: f1_def expand_singleton)
proof -
let ?h = "(λb. Functions I fid1 (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
let ?h' = "(λb'. FunctionFrechet I fid1 (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x) (χ i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))"
let ?f = "(λ b. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b))"
let ?f' = "(λ b'. (χ i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x b'))"
let ?g = "Functions I fid1"
let ?g'= "FunctionFrechet I fid1 (?f x)"
have heq:"?h = ?g ∘ ?f" by(rule ext, auto)
have heq':"?h' = ?g' ∘ ?f'" by(rule ext, auto)
have fderiv:"(?f has_derivative ?f') (at x)"
apply(rule has_derivative_vec)
by (auto simp add: svar_deriv axis_def)
have gderiv:"(?g has_derivative ?g') (at (?f x))"
using good_interp unfolding is_interp_def by blast
have gfderiv: "((?g ∘ ?f) has_derivative(?g' ∘ ?f')) (at x)"
using fderiv gderiv diff_chain_at by blast
have boring_eq:"(λb. Functions I fid1 (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) b)) =
sterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))"
by(rule ext, auto)
have "(?h has_derivative ?h') (at x)" using gfderiv heq heq' by auto
then show "(sterm_sem I ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)) has_derivative
(λv'. (THE f'. ∀x. (Functions I fid1 has_derivative f' x) (at x)) (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) x)
(χ i. frechet I (if i = vid1 then trm.Var vid1 else Const 0) x v')))
(at x)"
using boring_eq by auto
qed
done
proof -
have the_thing:"continuous_on (UNIV::('sz Rvec set))
(λb.
blinfun_vec
(λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
else Blinfun (λ_. 0)))"
apply(rule continuous_blinfun_vec')
subgoal for i
apply(cases "i = vid1")
apply(auto)
using frechet_continuous[OF good_interp freef1] by (auto simp add: continuous_on_const)
done
have another_cont:"continuous_on (UNIV)
(λx.
blinfun_vec
(λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
else Blinfun (λ_. 0)))"
apply(rule continuous_on_compose2[of UNIV "(λb. blinfun_vec
(λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
else Blinfun (λ_. 0)))"])
apply(rule the_thing)
by (auto intro!: continuous_intros)
have ext:"(λx. case x of
(t, b) ⇒
blinfun_vec
(λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
else Blinfun (λ_. 0))) =(λx.
blinfun_vec
(λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (snd x)
else Blinfun (λ_. 0))) " apply(rule ext, auto)
by (metis snd_conv)
then show "continuous_on (UNIV)
(λx. case x of
(t, b) ⇒
blinfun_vec
(λi. if i = vid1 then blin_frechet (good_interp I) (simple_term ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) b
else Blinfun (λ_. 0)))"
using another_cont
by (simp add: another_cont local.ext)
qed
have old_continuous:" ⋀x. x ∈ UNIV ⟹ continuous_on UNIV (λt. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) x else 0)"
by(rule continuous_on_const)
interpret ll_old: ll_on_open_it "UNIV" ?xode ?xconstraint 0
apply(standard)
subgoal by auto
prefer 3 subgoal by auto
prefer 3 subgoal by auto
apply(rule old_lipschitz)
by (rule old_continuous)
let ?ivl = "(ll_old.existence_ivl 0 (sol 0))"
let ?flow = "ll_old.flow 0 (sol 0)"
have tclosed:"{0..t} = {0--t}" using t real_Icc_closed_segment by auto
have "(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0..t} UNIV"
apply(rule solves_ode_supset_range)
apply(rule sol)
by auto
then have sol':"(sol solves_ode (λa b. χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0)) {0--t} UNIV"
using tclosed by auto
have sub:"{0--t} ⊆ ll_old.existence_ivl 0 (sol 0)"
apply(rule ll_old.closed_segment_subset_existence_ivl)
apply(rule ll_old.existence_ivl_maximal_segment)
apply(rule sol')
apply(rule refl)
by auto
have usol_old:"(?flow usolves_ode ?xode from 0) ?ivl UNIV"
by(rule ll_old.flow_usolves_ode, auto)
have sol_old:"(ll_old.flow 0 (sol 0) solves_ode ?xode) ?ivl UNIV"
by(rule ll_old.flow_solves_ode, auto)
have another_sub:"⋀s. s ∈ {0..t} ⟹ {s--0} ⊆ {0..t}"
unfolding closed_segment_def
apply auto
by (metis diff_0_right diff_left_mono mult.commute mult_left_le order.trans)
have sol_eq_flow:"⋀s. s ∈ {0..t} ⟹ sol s = ?flow s"
using usol_old apply simp
apply(drule usolves_odeD(4))
apply auto
subgoal for s x
proof -
assume xs0:"x ∈ {s--0}"
assume s0:"0 ≤ s" and st: "s ≤ t"
have "{s--0} ⊆ {0..t}" using another_sub[of s] s0 st by auto
then have "x ∈ {0..t}" using xs0 by auto
then have "x ∈ {0--t}" using tclosed by auto
then show "x ∈ ll_old.existence_ivl 0 (sol 0)"
using sub by auto
qed
apply(rule solves_ode_subset)
using sol' apply auto[1]
subgoal for s
proof -
assume s0:"0 ≤ s" and st:"s ≤ t"
show "{s--0} ⊆ {0--t}"
using tclosed unfolding closed_segment using s0 st
using another_sub intervalE by blast
qed
done
have sol_deriv_orig:"⋀s. s∈?ivl ⟹ (?flow has_derivative (λxa. xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
using sol_old apply simp
apply(drule solves_odeD(1))
by (auto simp add: has_vderiv_on_def has_vector_derivative_def)
have sol_eta:"(λt. χ i. ?flow t $ i) = ?flow" by(rule ext, rule vec_extensionality, auto)
have sol_deriv_eq1:"⋀s i. (λxa. xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (λxa. χ i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
by(rule ext, rule vec_extensionality, auto)
have sol_deriv_proj:"⋀s i. s∈?ivl ⟹ ((λt. ?flow t $ i) has_derivative (λxa. (xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)) (at s within ?ivl)"
subgoal for s i
apply(rule has_derivative_proj[of "(λ i t. ?flow t $ i)" "(λ i t'. (t' *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)" "(at s within ?ivl)" "i"])
using sol_deriv_orig[of s] sol_eta sol_deriv_eq1 by auto
done
have sol_deriv_eq2:"⋀s i. (λxa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) = (λxa. (xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)) $ i)"
by(rule ext, auto)
have sol_deriv_proj':"⋀s i. s∈?ivl ⟹ ((λt. ?flow t $ i) has_derivative (λxa. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))) (at s within ?ivl)"
subgoal for s i using sol_deriv_proj[of s i] sol_deriv_eq2[of i s] by metis done
have sol_deriv_proj_vid1:"⋀s. s∈?ivl ⟹ ((λt. ?flow t $ vid1) has_derivative (λxa. xa * (sterm_sem I (f1 fid1 vid1) (?flow s)))) (at s within ?ivl)"
subgoal for s
using sol_deriv_proj'[of s vid1] by auto done
have deriv1_args:"⋀s. s ∈ ?ivl ⟹ ((λ t. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t))) has_derivative ((λ t'. χ i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))) (at s within ?ivl)"
apply(rule has_derivative_vec)
by (auto simp add: sol_deriv_proj_vid1)
have con_fid:"⋀fid. continuous_on ?ivl (λx. sterm_sem I (f1 fid vid1) (?flow x))"
subgoal for fid
apply(rule has_derivative_continuous_on[of "?ivl" "(λx. sterm_sem I (f1 fid vid1) (?flow x))"
"(λt t'. FunctionFrechet I fid (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow t)) (χ i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow t) else 0)))"])
proof -
fix s
assume ivl:"s ∈ ?ivl"
let ?h = "(λx. sterm_sem I (f1 fid vid1) (?flow x))"
let ?g = "Functions I fid"
let ?f = "(λx. (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow x)))"
let ?h' = "(λt'. FunctionFrechet I fid (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
(χ i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0)))"
let ?g' = "FunctionFrechet I fid (?f s)"
let ?f' = "(λ t'. χ i . t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))"
have heq:"?h = ?g ∘ ?f" unfolding comp_def f1_def expand_singleton by auto
have heq':"?h' = ?g' ∘ ?f'" unfolding comp_def by auto
have fderiv:"(?f has_derivative ?f') (at s within ?ivl)"
using deriv1_args[OF ivl] by auto
have gderiv:"(?g has_derivative ?g') (at (?f s) within (?f ` ?ivl))"
using good_interp unfolding is_interp_def
using has_derivative_subset by blast
have gfderiv:"((?g ∘ ?f) has_derivative (?g' ∘ ?f')) (at s within ?ivl)"
using fderiv gderiv diff_chain_within by blast
show "((λx. sterm_sem I (f1 fid vid1) (?flow x)) has_derivative
(λt'. FunctionFrechet I fid (χ i. sterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (?flow s))
(χ i. t' * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (?flow s) else 0))))
(at s within ?ivl)"
using heq heq' gfderiv by auto
qed
done
have con:"⋀x. continuous_on (?ivl) (λt. x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
apply(rule continuous_on_add)
apply(rule continuous_on_mult_left)
apply(rule con_fid[of fid2])
by(rule con_fid[of fid3])
let ?axis = "(λ i. Blinfun(axis i))"
have bounded_linear_deriv:"⋀t. bounded_linear (λy' . y' *⇩R sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))"
using bounded_linear_scaleR_left by blast
have ll:"local_lipschitz (ll_old.existence_ivl 0 (sol 0)) UNIV (λt y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
apply(rule c1_implies_local_lipschitz[where f'="(λ (t,y). Blinfun(λy' . y' *⇩R sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"])
apply auto
subgoal for t x
apply(rule has_derivative_add_const)
proof -
have deriv:"((λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative (λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))) (at x)"
by(auto intro: derivative_eq_intros)
have eq:"(λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) = blinfun_apply (Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)))"
apply(rule ext)
using bounded_linear_deriv[of t] by (auto simp add: bounded_linear_Blinfun_apply)
show "((λx. x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t)) has_derivative
blinfun_apply (Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))))
(at x)" using deriv eq by auto
qed
apply(auto intro: continuous_intros simp add: split_beta')
proof -
have bounded_linear:"⋀x. bounded_linear (λy'. y' * sterm_sem I (f1 fid2 vid1) x)"
by (simp add: bounded_linear_mult_left)
have eq:"(λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) x)) = (λx. (sterm_sem I (f1 fid2 vid1) x) *⇩R id_blinfun)"
apply(rule ext, rule blinfun_eqI)
subgoal for x i
using bounded_linear[of x] apply(auto simp add: bounded_linear_Blinfun_apply)
by (simp add: blinfun.scaleR_left)
done
have conFlow:"continuous_on (ll_old.existence_ivl 0 (sol 0)) (ll_old.flow 0 (sol 0))"
using ll_old.general.flow_continuous_on by blast
have conF':"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))
(λx. (sterm_sem I (f1 fid2 vid1) x) *⇩R id_blinfun)"
apply(rule continuous_on_scaleR)
apply(auto intro: continuous_intros)
apply(rule sterm_continuous')
apply(rule good_interp)
by(auto simp add: f1_def intro: dfree.intros)
have conF:"continuous_on (ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))
(λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) x))"
apply(rule continuous_on_compose2[of "UNIV" "(λx. Blinfun (λy'. y' * x))" "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "sterm_sem I (f1 fid2 vid1)"])
subgoal by (metis blinfun_mult_left.abs_eq bounded_linear_blinfun_mult_left continuous_on_eq linear_continuous_on)
apply(rule sterm_continuous')
apply(rule good_interp)
by(auto simp add: f1_def intro: dfree.intros)
show "continuous_on (ll_old.existence_ivl 0 (sol 0) × UNIV) (λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) (fst x))))"
apply(rule continuous_on_compose2[of "ll_old.existence_ivl 0 (sol 0)" "(λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x)))" "(ll_old.existence_ivl 0 (sol 0) × UNIV)" "fst"])
apply(rule continuous_on_compose2[of "(ll_old.flow 0 (sol 0) ` ll_old.existence_ivl 0 (sol 0))" "(λx. Blinfun (λy'. y' * sterm_sem I (f1 fid2 vid1) x))"
"(ll_old.existence_ivl 0 (sol 0))" "(ll_old.flow 0 (sol 0))"])
using conF conFlow by (auto intro!: continuous_intros)
qed
let ?ivl = "ll_old.existence_ivl 0 (sol 0)"
let ?yode = "(λt y. y * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t))"
let ?ysol0 = r
interpret ll_new: ll_on_open_it "?ivl" "?yode" "UNIV" 0
apply(standard)
apply(auto)
apply(rule ll)
by(rule con)
have sol_new:"(ll_new.flow 0 r solves_ode ?yode) (ll_new.existence_ivl 0 r) UNIV"
by(rule ll_new.flow_solves_ode, auto)
have more_lipschitz:"⋀tm tM. tm ∈ ll_old.existence_ivl 0 (sol 0) ⟹
tM ∈ ll_old.existence_ivl 0 (sol 0) ⟹
∃M L. ∀t∈{tm..tM}. ∀x. ¦x * sterm_sem I (f1 fid2 vid1) (?flow t) + sterm_sem I (f1 fid3 vid1) (?flow t)¦ ≤ M + L * ¦x¦"
proof -
fix tm tM
assume tm:"tm ∈ ll_old.existence_ivl 0 (sol 0)"
assume tM:"tM ∈ ll_old.existence_ivl 0 (sol 0)"
let ?f2 = "(λt. sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) t))"
let ?f3 = "(λt. sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) t))"
let ?boundLP = "(λL t . (tm ≤ t ∧ t ≤ tM ⟶ ¦?f2 t¦ ≤ L))"
let ?boundL = "(SOME L. (∀t. ?boundLP L t))"
have compactT:"compact {tm..tM}" by auto
have sub:"{tm..tM} ⊆ ll_old.existence_ivl 0 (sol 0)"
by (metis atLeastatMost_empty_iff empty_subsetI ll_old.general.segment_subset_existence_ivl real_Icc_closed_segment tM tm)
let ?f2abs = "(λx. abs(?f2 x))"
have neg_compact:"⋀S::real set. compact S ⟹ compact ((λx. -x) ` S)"
by(rule compact_continuous_image, auto intro: continuous_intros)
have compactf2:"compact (?f2 ` {tm..tM})"
apply(rule compact_continuous_image)
apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid2 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
apply(rule sterm_continuous)
apply(rule good_interp)
subgoal by (auto intro: dfree.intros simp add: f1_def)
apply(rule continuous_on_subset)
prefer 2 apply (rule sub)
subgoal using ll_old.general.flow_continuous_on by blast
by auto
then have boundedf2:"bounded (?f2 ` {tm..tM})" using compact_imp_bounded by auto
then have boundedf2neg:"bounded ((λx. -x) ` ?f2 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
then have bdd_above_f2neg:"bdd_above ((λx. -x) ` ?f2 ` {tm..tM})" by (rule bounded_imp_bdd_above)
then have bdd_above_f2:"bdd_above ( ?f2 ` {tm..tM})" using bounded_imp_bdd_above boundedf2 by auto
have bdd_above_f2_abs:"bdd_above (abs ` ?f2 ` {tm..tM})"
using bdd_above_f2neg bdd_above_f2 unfolding bdd_above_def
apply auto
subgoal for M1 M2
apply(rule exI[where x="max M1 M2"])
by fastforce
done
then have theBound:"∃L. (∀t. ?boundLP L t)"
unfolding bdd_above_def norm_conv_dist
by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
then have boundLP:"∀t. ?boundLP (?boundL) t" using someI[of "(λ L. ∀t. ?boundLP L t)"] by blast
let ?boundMP = "(λM t. (tm ≤ t ∧ t ≤ tM ⟶ ¦?f3 t¦ ≤ M))"
let ?boundM = "(SOME M. (∀t. ?boundMP M t))"
have compactf3:"compact (?f3 ` {tm..tM})"
apply(rule compact_continuous_image)
apply(rule continuous_on_compose2[of UNIV "sterm_sem I (f1 fid3 vid1)" "{tm..tM}" "ll_old.flow 0 (sol 0)"])
apply(rule sterm_continuous)
apply(rule good_interp)
subgoal by (auto intro: dfree.intros simp add: f1_def)
apply(rule continuous_on_subset)
prefer 2 apply (rule sub)
subgoal using ll_old.general.flow_continuous_on by blast
by auto
then have boundedf3:"bounded (?f3 ` {tm..tM})" using compact_imp_bounded by auto
then have boundedf3neg:"bounded ((λx. -x) ` ?f3 ` {tm..tM})" using compact_imp_bounded neg_compact by auto
then have bdd_above_f3neg:"bdd_above ((λx. -x) ` ?f3 ` {tm..tM})" by (rule bounded_imp_bdd_above)
then have bdd_above_f3:"bdd_above ( ?f3 ` {tm..tM})" using bounded_imp_bdd_above boundedf3 by auto
have bdd_above_f3_abs:"bdd_above (abs ` ?f3 ` {tm..tM})"
using bdd_above_f3neg bdd_above_f3 unfolding bdd_above_def
apply auto
subgoal for M1 M2
apply(rule exI[where x="max M1 M2"])
by fastforce
done
then have theBound:"∃L. (∀t. ?boundMP L t)"
unfolding bdd_above_def norm_conv_dist
by (auto simp add: Ball_def Bex_def norm_conv_dist image_iff norm_bcontfun_def dist_blinfun_def)
then have boundMP:"∀t. ?boundMP (?boundM) t" using someI[of "(λ M. ∀t. ?boundMP M t)"] by blast
show "∃M L. ∀t∈{tm..tM}. ∀x. ¦x * ?f2 t + ?f3 t¦ ≤ M + L * ¦x¦"
apply(rule exI[where x="?boundM"])
apply(rule exI[where x="?boundL"])
apply auto
proof -
fix t and x :: real
assume ttm:"tm ≤ t"
assume ttM:"t ≤ tM"
from ttm ttM have ttmM:"tm ≤ t ∧ t ≤ tM" by auto
have leqf3:"¦?f3 t¦ ≤ ?boundM" using boundMP ttmM by auto
have leqf2:"¦?f2 t¦ ≤ ?boundL" using boundLP ttmM by auto
have gr0:" ¦x¦ ≥ 0" by auto
have leqf2x:"¦?f2 t¦ * ¦x¦ ≤ ?boundL * ¦x¦" using gr0 leqf2
by (metis (no_types, lifting) real_scaleR_def scaleR_right_mono)
have "¦x * ?f2 t + ?f3 t¦ ≤ ¦x¦ * ¦?f2 t¦ + ¦?f3 t¦"
proof -
have f1: "⋀r ra. ¦r::real¦ * ¦ra¦ = ¦r * ra¦"
by (metis norm_scaleR real_norm_def real_scaleR_def)
have "⋀r ra. ¦(r::real) + ra¦ ≤ ¦r¦ + ¦ra¦"
by (metis norm_triangle_ineq real_norm_def)
then show ?thesis
using f1 by presburger
qed
moreover have "... = ¦?f3 t¦ + ¦?f2 t¦ * ¦x¦"
by auto
moreover have "... ≤ ?boundM + ¦?f2 t¦ * ¦x¦"
using leqf3 by linarith
moreover have "... ≤ ?boundM + ?boundL * ¦x¦"
using leqf2x by linarith
ultimately show "¦x * ?f2 t + ?f3 t¦ ≤ ?boundM + ?boundL * ¦x¦"
by linarith
qed
qed
have ivls_eq:"(ll_new.existence_ivl 0 r) = (ll_old.existence_ivl 0 (sol 0))"
apply(rule ll_new.existence_ivl_eq_domain)
apply auto
apply (rule more_lipschitz)
by auto
have sub':"{0--t} ⊆ ll_new.existence_ivl 0 r"
using sub ivls_eq by auto
have sol_new':"(ll_new.flow 0 r solves_ode ?yode) {0--t} UNIV"
by(rule solves_ode_subset, rule sol_new, rule sub')
let ?soly = "ll_new.flow 0 r"
let ?sol' = "(λt. χ i. if i = vid2 then ?soly t else sol t $ i)"
let ?aaba' = "mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b)
(?sol' t)"
have duh:"(fst ?aaba', snd ?aaba') = ?aaba'" by auto
note bigEx = spec[OF spec[OF bigAll, where x="fst ?aaba'"], where x="snd ?aaba'"]
have sol_deriv:"⋀s. s ∈ {0..t} ⟹ (sol has_derivative (λxa. xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))) (at s within {0..t})"
using sol apply simp
by(drule solves_odeD(1), auto simp add: has_vderiv_on_def has_vector_derivative_def)
have silly_eq1:"(λt. χ i. sol t $ i) = sol"
by(rule ext, rule vec_extensionality, auto)
have silly_eq2:"⋀s. (λxa. χ i. (xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i) = (λxa. xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0))"
by(rule ext, rule vec_extensionality, auto)
have sol_proj_deriv:"⋀s i. s ∈ {0..t} ⟹ ((λ t. sol t $ i) has_derivative (λxa. (xa *⇩R (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (sol s) else 0)) $ i)) (at s within {0..t})"
subgoal for s i
apply(rule has_derivative_proj)
using sol_deriv[of s] silly_eq1 silly_eq2[of s] by auto
done
have sol_proj_deriv_vid1:"⋀s. s ∈ {0..t} ⟹ ((λ t. sol t $ vid1) has_derivative (λxa. xa * sterm_sem I (f1 fid1 vid1) (sol s))) (at s within {0..t})"
subgoal for s using sol_proj_deriv[of s vid1] by auto done
have sol_proj_deriv_other:"⋀s i. s ∈ {0..t} ⟹ i ≠ vid1 ⟹ ((λ t. sol t $ i) has_derivative (λxa. 0)) (at s within {0..t})"
subgoal for s i using sol_proj_deriv[of s i] by auto done
have fact:"⋀x. x ∈{0..t} ⟹
(ll_new.flow 0 r has_derivative
(λxa. xa *⇩R (ll_new.flow 0 r x * sterm_sem I (f1 fid2 vid1) (ll_old.flow 0 (sol 0) x) +
sterm_sem I (f1 fid3 vid1) (ll_old.flow 0 (sol 0) x))))
(at x within {0 .. t})"
using sol_new' apply simp
apply(drule solves_odeD(1))
using tclosed unfolding has_vderiv_on_def has_vector_derivative_def by auto
have new_sol_deriv:"⋀s. s ∈ {0..t} ⟹ (ll_new.flow 0 r has_derivative
(λxa. xa *⇩R (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s))))
(at s within {0.. t})"
subgoal for s
using fact[of s] tclosed sol_eq_flow[of s] by auto
done
have sterm_agree:"⋀s. Vagree (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) {Inl vid1}"
subgoal for s unfolding Vagree_def using vne12 by auto done
have FVF:"(FVT (f1 fid2 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
have FVF2:"(FVT (f1 fid3 vid1)) = {Inl vid1}" unfolding f1_def expand_singleton apply auto subgoal for x xa by (cases "xa = vid1", auto) done
have sterm_agree_FVF:"⋀s. Vagree (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid2 vid1))"
using sterm_agree FVF by auto
have sterm_agree_FVF2:"⋀s. Vagree (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (sol s, undefined) (FVT (f1 fid3 vid1))"
using sterm_agree FVF2 by auto
have y_component_sem_eq2:"⋀s. sterm_sem I (f1 fid2 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
= sterm_sem I (f1 fid2 vid1) (sol s)"
using coincidence_sterm[OF sterm_agree_FVF, of I] by auto
have y_component_sem_eq3:"⋀s. sterm_sem I (f1 fid3 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
= sterm_sem I (f1 fid3 vid1) (sol s)"
using coincidence_sterm[OF sterm_agree_FVF2, of I] by auto
have y_component_ode_eq:"⋀s. s ∈ {0..t} ⟹
(λxa. xa * (ll_new.flow 0 r s * sterm_sem I (f1 fid2 vid1) (sol s) + sterm_sem I (f1 fid3 vid1) (sol s)))
= (λxa. xa * (sterm_sem I (f1 fid2 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) * ll_new.flow 0 r s +
sterm_sem I (f1 fid3 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
subgoal for s
apply(rule ext)
subgoal for xa
using y_component_sem_eq2 y_component_sem_eq3 by auto
done
done
have agree_vid1:"⋀s. Vagree (sol s, undefined) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) {Inl vid1}"
unfolding Vagree_def using vne12 by auto
have FVT_vid1:"FVT(f1 fid1 vid1) = {Inl vid1}" apply(auto simp add: f1_def) subgoal for x xa apply(cases "xa = vid1") by auto done
have agree_vid1_FVT:"⋀s. Vagree (sol s, undefined) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i, undefined) (FVT (f1 fid1 vid1))"
using FVT_vid1 agree_vid1 by auto
have sterm_eq_vid1:"⋀s. sterm_sem I (f1 fid1 vid1) (sol s) = sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"
subgoal for s
using coincidence_sterm[OF agree_vid1_FVT[of s], of I] by auto
done
have vid1_deriv_eq:"⋀s. (λxa. xa * sterm_sem I (f1 fid1 vid1) (sol s)) =
(λxa. xa * sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
subgoal for s
apply(rule ext)
subgoal for x'
using sterm_eq_vid1[of s] by auto
done done
have inner_deriv:"⋀s. s ∈ {0..t} ⟹
((λt. χ i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative (λxa. (χ i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))))
(at s within {0..t})"
subgoal for s
apply(rule has_derivative_vec)
subgoal for i
apply(cases "i = vid2")
subgoal
using vne12
using new_sol_deriv[of s]
using y_component_ode_eq by auto
subgoal
apply(cases "i = vid1")
using sol_proj_deriv_vid1[of s] vid1_deriv_eq[of s] sol_proj_deriv_other[of s i] by auto
done
done
done
have deriv_eta:"⋀s. (λxa. xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
(χ i. if i = vid2
then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
(χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
else 0)))
= (λxa. (χ i. xa * (if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else
if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0))) "
subgoal for s
apply(rule ext)
apply(rule vec_extensionality)
using vne12 by auto
done
have sol'_deriv:"⋀s. s ∈ {0..t} ⟹
((λt. χ i. if i = vid2 then ll_new.flow 0 r t else sol t $ i) has_derivative
(λxa. xa *⇩R ((χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i) else 0) +
(χ i. if i = vid2
then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1))
(χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)
else 0))))
(at s within {0..t})"
subgoal for s
using inner_deriv[of s] deriv_eta[of s] by auto done
have FVT:"⋀i. FVT (if i = vid1 then trm.Var vid1 else Const 0) ⊆ {Inl vid1}" by auto
have agree:"⋀s. Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) {Inl vid1}"
subgoal for s
using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol s)"]
using mk_v_agree [of I "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))" "(χ y. if vid2 = y then r else fst (a, b) $ y, b)" "(χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)"]
unfolding Vagree_def using vne12 by simp
done
have agree':"⋀s i. Vagree (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)) (mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)) (FVT (if i = vid1 then trm.Var vid1 else Const 0))"
subgoal for s i using agree_sub[OF FVT[of i] agree[of s]] by auto done
have safe:"⋀i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)" subgoal for i apply(cases "i = vid1", auto) done done
have dterm_sem_eq:"⋀s i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s))
= dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i))"
subgoal for s i using coincidence_dterm[OF safe[of i] agree'[of s i], of I] by auto done
have dterm_vec_eq:"⋀s. (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) (mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s)))
= (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
subgoal for s
apply(rule vec_extensionality)
subgoal for i using dterm_sem_eq[of i s] by auto
done done
have pred_same:"⋀s. s ∈ {0..t} ⟹ Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol s))) ⟹
Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
subgoal for s using dterm_vec_eq[of s] by auto done
have sol'_domain:"⋀s. 0 ≤ s ⟹
s ≤ t ⟹
Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) (χ i. if i = vid2 then ll_new.flow 0 r s else sol s $ i)))"
subgoal for s
using sol apply simp
apply(drule solves_odeD(2))
using pred_same[of s] by auto
done
have sol':"(?sol' solves_ode
(λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
{0..t} {x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
(χ y. if vid2 = y then r else fst (a, b) $ y, b) x))}"
apply(rule solves_odeI)
subgoal
unfolding has_vderiv_on_def has_vector_derivative_def
using sol'_deriv by auto
by(auto, rule sol'_domain, auto)
have set_eq:"{y. y = vid2 ∨ y = vid1 ∨ y = vid2 ∨ y = vid1 ∨ (∃x. Inl y ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))} = {vid1, vid2}"
by auto
have "VSagree (?sol' 0) (χ y. if vid2 = y then r else fst (a, b) $ y) {vid1, vid2}"
using VSA unfolding VSagree_def by simp
then have VSA':" VSagree (?sol' 0) (χ y. if vid2 = y then r else fst (a, b) $ y)
{y. y = vid2 ∨ y = vid1 ∨ y = vid2 ∨ y = vid1 ∨ (∃x. Inl y ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))} "
by (auto simp add: set_eq)
have bigPre:"(∃sol t. (fst ?aaba', snd ?aaba') =
mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
((χ y. if vid2 = y then r else fst (a,b) $ y), b) (sol t) ∧
0 ≤ t ∧
(sol solves_ode
(λa b. (χ i. if i = vid1 then sterm_sem I (f1 fid1 vid1) b else 0) +
(χ i. if i = vid2 then sterm_sem I (Plus (Times (f1 fid2 vid1) (trm.Var vid2)) (f1 fid3 vid1)) b else 0)))
{0..t} {x. Predicates I vid1
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))
((χ y. if vid2 = y then r else (fst (a,b)) $ y), b) x))} ∧
VSagree (sol 0) (χ y. if vid2 = y then r else fst (a,b) $ y)
{uu. uu = vid2 ∨
uu = vid1 ∨
uu = vid2 ∨
uu = vid1 ∨
Inl uu ∈ Inl ` ({x. ∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0)} ∪
{x. x = vid2 ∨ (∃xa. Inl x ∈ FVT (if xa = vid1 then trm.Var vid1 else Const 0))}) ∨
(∃x. Inl uu ∈ FVT (if x = vid1 then trm.Var vid1 else Const 0))})"
apply(rule exI[where x="?sol'"])
apply(rule exI[where x=t])
apply(rule conjI)
subgoal by simp
apply(rule conjI)
subgoal by (rule t)
apply(rule conjI)
apply(rule sol')
using VSA' unfolding VSagree_def by auto
have pred_sem:"Predicates I vid2 (χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba')"
using mp[OF bigEx bigPre] by auto
let ?other_state = "(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t))"
have agree:"Vagree (?aaba') (?other_state) {Inl vid1} "
using mk_v_agree [of "I" "(OProd (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))
(OSing vid2
(Plus (Times ($f fid2 (λi. if i = vid1 then trm.Var vid1 else Const 0)) (trm.Var vid2))
($f fid3 (λi. if i = vid1 then trm.Var vid1 else Const 0)))))"
"(χ y. if vid2 = y then r else fst (a, b) $ y, b)" "(?sol' t)"]
using mk_v_agree [of "I" "(OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0)))" "(a, b)" "(sol t)"]
unfolding Vagree_def using vne12 by simp
have sub:"⋀i. FVT (if i = vid1 then trm.Var vid1 else Const 0) ⊆ {Inl vid1}"
by auto
have agree':"⋀i. Vagree (?aaba') (?other_state) (FVT (if i = vid1 then trm.Var vid1 else Const 0)) "
subgoal for i using agree_sub[OF sub[of i] agree] by auto done
have silly_safe:"⋀i. dsafe (if i = vid1 then trm.Var vid1 else Const 0)"
subgoal for i
apply(cases "i = vid1")
by (auto simp add: dsafe_Var dsafe_Const)
done
have dsem_eq:"(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?aaba') =
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0) ?other_state)"
apply(rule vec_extensionality)
subgoal for i
using coincidence_dterm[OF silly_safe[of i] agree'[of i], of I] by auto
done
show
"Predicates I vid2
(χ i. dterm_sem I (if i = vid1 then trm.Var vid1 else Const 0)
(mk_v I (OSing vid1 ($f fid1 (λi. if i = vid1 then trm.Var vid1 else Const 0))) (a, b) (sol t)))"
using pred_sem dsem_eq by auto
qed
done
qed
end end
Theory USubst
theory "USubst"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Static_Semantics"
begin
section ‹Uniform Substitution Definitions›
text‹This section defines substitutions and implements the substitution operation.
Every part of substitution comes in two flavors. The "Nsubst" variant of each function
returns a term/formula/ode/program which (as encoded in the type system) has less symbols
that the input. We use this operation when substitution into functions and function-like
constructs to make it easy to distinguish identifiers that stand for arguments to functions
from other identifiers. In order to expose a simpler interface, we also have a "subst" variant
which does not delete variables.
Naive substitution without side conditions would not always be sound. The various admissibility
predicates *admit describe conditions under which the various substitution operations are sound.
›
text‹
Explicit data structure for substitutions.
The RHS of a function or predicate substitution is a term or formula
with extra variables, which are used to refer to arguments. ›
record ('a, 'b, 'c) subst =
SFunctions :: "'a ⇀ ('a + 'c, 'c) trm"
SPredicates :: "'c ⇀ ('a + 'c, 'b, 'c) formula"
SContexts :: "'b ⇀ ('a, 'b + unit, 'c) formula"
SPrograms :: "'c ⇀ ('a, 'b, 'c) hp"
SODEs :: "'c ⇀ ('a, 'c) ODE"
context ids begin
definition NTUadmit :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'c) trm ⇒ ('c + 'c) set ⇒ bool"
where "NTUadmit σ θ U ⟷ ((⋃ i ∈ {i. Inr i ∈ SIGT θ}. FVT (σ i)) ∩ U) = {}"
inductive TadmitFFO :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'c) trm ⇒ bool"
where
TadmitFFO_Diff:"TadmitFFO σ θ ⟹ NTUadmit σ θ UNIV ⟹ TadmitFFO σ (Differential θ)"
| TadmitFFO_Fun1:"(⋀i. TadmitFFO σ (args i)) ⟹ TadmitFFO σ (Function (Inl f) args)"
| TadmitFFO_Fun2:"(⋀i. TadmitFFO σ (args i)) ⟹ dfree (σ f) ⟹ TadmitFFO σ (Function (Inr f) args)"
| TadmitFFO_Plus:"TadmitFFO σ θ1 ⟹ TadmitFFO σ θ2 ⟹ TadmitFFO σ (Plus θ1 θ2)"
| TadmitFFO_Times:"TadmitFFO σ θ1 ⟹ TadmitFFO σ θ2 ⟹ TadmitFFO σ (Times θ1 θ2)"
| TadmitFFO_Var:"TadmitFFO σ (Var x)"
| TadmitFFO_Const:"TadmitFFO σ (Const r)"
inductive_simps
TadmitFFO_Diff_simps[simp]: "TadmitFFO σ (Differential θ)"
and TadmitFFO_Fun_simps[simp]: "TadmitFFO σ (Function f args)"
and TadmitFFO_Plus_simps[simp]: "TadmitFFO σ (Plus t1 t2)"
and TadmitFFO_Times_simps[simp]: "TadmitFFO σ (Times t1 t2)"
and TadmitFFO_Var_simps[simp]: "TadmitFFO σ (Var x)"
and TadmitFFO_Const_simps[simp]: "TadmitFFO σ (Const r)"
primrec TsubstFO::"('a + 'b, 'c) trm ⇒ ('b ⇒ ('a, 'c) trm) ⇒ ('a, 'c) trm"
where
"TsubstFO (Var v) σ = Var v"
| "TsubstFO (DiffVar v) σ = DiffVar v"
| "TsubstFO (Const r) σ = Const r"
| "TsubstFO (Function f args) σ =
(case f of
Inl f' ⇒ Function f' (λ i. TsubstFO (args i) σ)
| Inr f' ⇒ σ f')"
| "TsubstFO (Plus θ1 θ2) σ = Plus (TsubstFO θ1 σ) (TsubstFO θ2 σ)"
| "TsubstFO (Times θ1 θ2) σ = Times (TsubstFO θ1 σ) (TsubstFO θ2 σ)"
| "TsubstFO (Differential θ) σ = Differential (TsubstFO θ σ)"
inductive TadmitFO :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'c) trm ⇒ bool"
where
TadmitFO_Diff:"TadmitFFO σ θ ⟹ NTUadmit σ θ UNIV ⟹ dfree (TsubstFO θ σ) ⟹ TadmitFO σ (Differential θ)"
| TadmitFO_Fun:"(⋀i. TadmitFO σ (args i)) ⟹ TadmitFO σ (Function f args)"
| TadmitFO_Plus:"TadmitFO σ θ1 ⟹ TadmitFO σ θ2 ⟹ TadmitFO σ (Plus θ1 θ2)"
| TadmitFO_Times:"TadmitFO σ θ1 ⟹ TadmitFO σ θ2 ⟹ TadmitFO σ (Times θ1 θ2)"
| TadmitFO_DiffVar:"TadmitFO σ (DiffVar x)"
| TadmitFO_Var:"TadmitFO σ (Var x)"
| TadmitFO_Const:"TadmitFO σ (Const r)"
inductive_simps
TadmitFO_Plus_simps[simp]: "TadmitFO σ (Plus a b)"
and TadmitFO_Times_simps[simp]: "TadmitFO σ (Times a b)"
and TadmitFO_Var_simps[simp]: "TadmitFO σ (Var x)"
and TadmitFO_DiffVar_simps[simp]: "TadmitFO σ (DiffVar x)"
and TadmitFO_Differential_simps[simp]: "TadmitFO σ (Differential θ)"
and TadmitFO_Const_simps[simp]: "TadmitFO σ (Const r)"
and TadmitFO_Fun_simps[simp]: "TadmitFO σ (Function i args)"
primrec Tsubst::"('a, 'c) trm ⇒ ('a, 'b, 'c) subst ⇒ ('a, 'c) trm"
where
"Tsubst (Var x) σ = Var x"
| "Tsubst (DiffVar x) σ = DiffVar x"
| "Tsubst (Const r) σ = Const r"
| "Tsubst (Function f args) σ = (case SFunctions σ f of Some f' ⇒ TsubstFO f' | None ⇒ Function f) (λ i. Tsubst (args i) σ)"
| "Tsubst (Plus θ1 θ2) σ = Plus (Tsubst θ1 σ) (Tsubst θ2 σ)"
| "Tsubst (Times θ1 θ2) σ = Times (Tsubst θ1 σ) (Tsubst θ2 σ)"
| "Tsubst (Differential θ) σ = Differential (Tsubst θ σ)"
primrec OsubstFO::"('a + 'b, 'c) ODE ⇒ ('b ⇒ ('a, 'c) trm) ⇒ ('a, 'c) ODE"
where
"OsubstFO (OVar c) σ = OVar c"
| "OsubstFO (OSing x θ) σ = OSing x (TsubstFO θ σ)"
| "OsubstFO (OProd ODE1 ODE2) σ = OProd (OsubstFO ODE1 σ) (OsubstFO ODE2 σ)"
primrec Osubst::"('a, 'c) ODE ⇒ ('a, 'b, 'c) subst ⇒ ('a, 'c) ODE"
where
"Osubst (OVar c) σ = (case SODEs σ c of Some c' ⇒ c' | None ⇒ OVar c)"
| "Osubst (OSing x θ) σ = OSing x (Tsubst θ σ)"
| "Osubst (OProd ODE1 ODE2) σ = OProd (Osubst ODE1 σ) (Osubst ODE2 σ)"
fun PsubstFO::"('a + 'd, 'b, 'c) hp ⇒ ('d ⇒ ('a, 'c) trm) ⇒ ('a, 'b, 'c) hp"
and FsubstFO::"('a + 'd, 'b, 'c) formula ⇒ ('d ⇒ ('a, 'c) trm) ⇒ ('a, 'b, 'c) formula"
where
"PsubstFO (Pvar a) σ = Pvar a"
| "PsubstFO (Assign x θ) σ = Assign x (TsubstFO θ σ)"
| "PsubstFO (DiffAssign x θ) σ = DiffAssign x (TsubstFO θ σ)"
| "PsubstFO (Test φ) σ = Test (FsubstFO φ σ)"
| "PsubstFO (EvolveODE ODE φ) σ = EvolveODE (OsubstFO ODE σ) (FsubstFO φ σ)"
| "PsubstFO (Choice α β) σ = Choice (PsubstFO α σ) (PsubstFO β σ)"
| "PsubstFO (Sequence α β) σ = Sequence (PsubstFO α σ) (PsubstFO β σ)"
| "PsubstFO (Loop α) σ = Loop (PsubstFO α σ)"
| "FsubstFO (Geq θ1 θ2) σ = Geq (TsubstFO θ1 σ) (TsubstFO θ2 σ)"
| "FsubstFO (Prop p args) σ = Prop p (λi. TsubstFO (args i) σ)"
| "FsubstFO (Not φ) σ = Not (FsubstFO φ σ)"
| "FsubstFO (And φ ψ) σ = And (FsubstFO φ σ) (FsubstFO ψ σ)"
| "FsubstFO (Exists x φ) σ = Exists x (FsubstFO φ σ)"
| "FsubstFO (Diamond α φ) σ = Diamond (PsubstFO α σ) (FsubstFO φ σ)"
| "FsubstFO (InContext C φ) σ = InContext C (FsubstFO φ σ)"
fun PPsubst::"('a, 'b + 'd, 'c) hp ⇒ ('d ⇒ ('a, 'b, 'c) formula) ⇒ ('a, 'b, 'c) hp"
and PFsubst::"('a, 'b + 'd, 'c) formula ⇒ ('d ⇒ ('a, 'b, 'c) formula) ⇒ ('a, 'b, 'c) formula"
where
"PPsubst (Pvar a) σ = Pvar a"
| "PPsubst (Assign x θ) σ = Assign x θ"
| "PPsubst (DiffAssign x θ) σ = DiffAssign x θ"
| "PPsubst (Test φ) σ = Test (PFsubst φ σ)"
| "PPsubst (EvolveODE ODE φ) σ = EvolveODE ODE (PFsubst φ σ)"
| "PPsubst (Choice α β) σ = Choice (PPsubst α σ) (PPsubst β σ)"
| "PPsubst (Sequence α β) σ = Sequence (PPsubst α σ) (PPsubst β σ)"
| "PPsubst (Loop α) σ = Loop (PPsubst α σ)"
| "PFsubst (Geq θ1 θ2) σ = (Geq θ1 θ2)"
| "PFsubst (Prop p args) σ = Prop p args"
| "PFsubst (Not φ) σ = Not (PFsubst φ σ)"
| "PFsubst (And φ ψ) σ = And (PFsubst φ σ) (PFsubst ψ σ)"
| "PFsubst (Exists x φ) σ = Exists x (PFsubst φ σ)"
| "PFsubst (Diamond α φ) σ = Diamond (PPsubst α σ) (PFsubst φ σ)"
| "PFsubst (InContext C φ) σ = (case C of Inl C' ⇒ InContext C' (PFsubst φ σ) | Inr p' ⇒ σ p')"
fun Psubst::"('a, 'b, 'c) hp ⇒ ('a, 'b, 'c) subst ⇒ ('a, 'b, 'c) hp"
and Fsubst::"('a, 'b, 'c) formula ⇒ ('a, 'b, 'c) subst ⇒ ('a, 'b, 'c) formula"
where
"Psubst (Pvar a) σ = (case SPrograms σ a of Some a' ⇒ a' | None ⇒ Pvar a)"
| "Psubst (Assign x θ) σ = Assign x (Tsubst θ σ)"
| "Psubst (DiffAssign x θ) σ = DiffAssign x (Tsubst θ σ)"
| "Psubst (Test φ) σ = Test (Fsubst φ σ)"
| "Psubst (EvolveODE ODE φ) σ = EvolveODE (Osubst ODE σ) (Fsubst φ σ)"
| "Psubst (Choice α β) σ = Choice (Psubst α σ) (Psubst β σ)"
| "Psubst (Sequence α β) σ = Sequence (Psubst α σ) (Psubst β σ)"
| "Psubst (Loop α) σ = Loop (Psubst α σ)"
| "Fsubst (Geq θ1 θ2) σ = Geq (Tsubst θ1 σ) (Tsubst θ2 σ)"
| "Fsubst (Prop p args) σ = (case SPredicates σ p of Some p' ⇒ FsubstFO p' (λi. Tsubst (args i) σ) | None ⇒ Prop p (λi. Tsubst (args i) σ))"
| "Fsubst (Not φ) σ = Not (Fsubst φ σ)"
| "Fsubst (And φ ψ) σ = And (Fsubst φ σ) (Fsubst ψ σ)"
| "Fsubst (Exists x φ) σ = Exists x (Fsubst φ σ)"
| "Fsubst (Diamond α φ) σ = Diamond (Psubst α σ) (Fsubst φ σ)"
| "Fsubst (InContext C φ) σ = (case SContexts σ C of Some C' ⇒ PFsubst C' (λ _. (Fsubst φ σ)) | None ⇒ InContext C (Fsubst φ σ))"
definition FVA :: "('a ⇒ ('a, 'c) trm) ⇒ ('c + 'c) set"
where "FVA args = (⋃ i. FVT (args i))"
fun SFV :: "('a, 'b, 'c) subst ⇒ ('a + 'b + 'c) ⇒ ('c + 'c) set"
where "SFV σ (Inl i) = (case SFunctions σ i of Some f' ⇒ FVT f' | None ⇒ {})"
| "SFV σ (Inr (Inl i)) = {}"
| "SFV σ (Inr (Inr i)) = (case SPredicates σ i of Some p' ⇒ FVF p' | None ⇒ {})"
definition FVS :: "('a, 'b, 'c) subst ⇒ ('c + 'c) set"
where "FVS σ = (⋃i. SFV σ i)"
definition SDom :: "('a, 'b, 'c) subst ⇒ ('a + 'b + 'c) set"
where "SDom σ =
{Inl x | x. x ∈ dom (SFunctions σ)}
∪ {Inr (Inl x) | x. x ∈ dom (SContexts σ)}
∪ {Inr (Inr x) | x. x ∈ dom (SPredicates σ)}
∪ {Inr (Inr x) | x. x ∈ dom (SPrograms σ)}"
definition TUadmit :: "('a, 'b, 'c) subst ⇒ ('a, 'c) trm ⇒ ('c + 'c) set ⇒ bool"
where "TUadmit σ θ U ⟷ ((⋃ i ∈ SIGT θ. (case SFunctions σ i of Some f' ⇒ FVT f' | None ⇒ {})) ∩ U) = {}"
inductive Tadmit :: "('a, 'b, 'c) subst ⇒ ('a, 'c) trm ⇒ bool"
where
Tadmit_Diff:"Tadmit σ θ ⟹ TUadmit σ θ UNIV ⟹ Tadmit σ (Differential θ)"
| Tadmit_Fun1:"(⋀i. Tadmit σ (args i)) ⟹ SFunctions σ f = Some f' ⟹ TadmitFO (λ i. Tsubst (args i) σ) f' ⟹ Tadmit σ (Function f args)"
| Tadmit_Fun2:"(⋀i. Tadmit σ (args i)) ⟹ SFunctions σ f = None ⟹ Tadmit σ (Function f args)"
| Tadmit_Plus:"Tadmit σ θ1 ⟹ Tadmit σ θ2 ⟹ Tadmit σ (Plus θ1 θ2)"
| Tadmit_Times:"Tadmit σ θ1 ⟹ Tadmit σ θ2 ⟹ Tadmit σ (Times θ1 θ2)"
| Tadmit_DiffVar:"Tadmit σ (DiffVar x)"
| Tadmit_Var:"Tadmit σ (Var x)"
| Tadmit_Const:"Tadmit σ (Const r)"
inductive_simps
Tadmit_Plus_simps[simp]: "Tadmit σ (Plus a b)"
and Tadmit_Times_simps[simp]: "Tadmit σ (Times a b)"
and Tadmit_Var_simps[simp]: "Tadmit σ (Var x)"
and Tadmit_DiffVar_simps[simp]: "Tadmit σ (DiffVar x)"
and Tadmit_Differential_simps[simp]: "Tadmit σ (Differential θ)"
and Tadmit_Const_simps[simp]: "Tadmit σ (Const r)"
and Tadmit_Fun_simps[simp]: "Tadmit σ (Function i args)"
inductive TadmitF :: "('a, 'b, 'c) subst ⇒ ('a, 'c) trm ⇒ bool"
where
TadmitF_Diff:"TadmitF σ θ ⟹ TUadmit σ θ UNIV ⟹ TadmitF σ (Differential θ)"
| TadmitF_Fun1:"(⋀i. TadmitF σ (args i)) ⟹ SFunctions σ f = Some f' ⟹ (⋀i. dfree (Tsubst (args i) σ)) ⟹ TadmitFFO (λ i. Tsubst (args i) σ) f' ⟹ TadmitF σ (Function f args)"
| TadmitF_Fun2:"(⋀i. TadmitF σ (args i)) ⟹ SFunctions σ f = None ⟹ TadmitF σ (Function f args)"
| TadmitF_Plus:"TadmitF σ θ1 ⟹ TadmitF σ θ2 ⟹ TadmitF σ (Plus θ1 θ2)"
| TadmitF_Times:"TadmitF σ θ1 ⟹ TadmitF σ θ2 ⟹ TadmitF σ (Times θ1 θ2)"
| TadmitF_DiffVar:"TadmitF σ (DiffVar x)"
| TadmitF_Var:"TadmitF σ (Var x)"
| TadmitF_Const:"TadmitF σ (Const r)"
inductive_simps
TadmitF_Plus_simps[simp]: "TadmitF σ (Plus a b)"
and TadmitF_Times_simps[simp]: "TadmitF σ (Times a b)"
and TadmitF_Var_simps[simp]: "TadmitF σ (Var x)"
and TadmitF_DiffVar_simps[simp]: "TadmitF σ (DiffVar x)"
and TadmitF_Differential_simps[simp]: "TadmitF σ (Differential θ)"
and TadmitF_Const_simps[simp]: "TadmitF σ (Const r)"
and TadmitF_Fun_simps[simp]: "TadmitF σ (Function i args)"
inductive Oadmit:: "('a, 'b, 'c) subst ⇒ ('a, 'c) ODE ⇒ ('c + 'c) set ⇒ bool"
where
Oadmit_Var:"Oadmit σ (OVar c) U"
| Oadmit_Sing:"TUadmit σ θ U ⟹ TadmitF σ θ ⟹ Oadmit σ (OSing x θ) U"
| Oadmit_Prod:"Oadmit σ ODE1 U ⟹ Oadmit σ ODE2 U ⟹ ODE_dom (Osubst ODE1 σ) ∩ ODE_dom (Osubst ODE2 σ) = {} ⟹ Oadmit σ (OProd ODE1 ODE2) U"
inductive_simps
Oadmit_Var_simps[simp]: "Oadmit σ (OVar c) U"
and Oadmit_Sing_simps[simp]: "Oadmit σ (OSing x e) U"
and Oadmit_Prod_simps[simp]: "Oadmit σ (OProd ODE1 ODE2) U"
definition PUadmit :: "('a, 'b, 'c) subst ⇒ ('a, 'b, 'c) hp ⇒ ('c + 'c) set ⇒ bool"
where "PUadmit σ θ U ⟷ ((⋃ i ∈ (SDom σ ∩ SIGP θ). SFV σ i) ∩ U) = {}"
definition FUadmit :: "('a, 'b, 'c) subst ⇒ ('a, 'b, 'c) formula ⇒ ('c + 'c) set ⇒ bool"
where "FUadmit σ θ U ⟷ ((⋃ i ∈ (SDom σ ∩ SIGF θ). SFV σ i) ∩ U) = {}"
definition OUadmitFO :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'c) ODE ⇒ ('c + 'c) set ⇒ bool"
where "OUadmitFO σ θ U ⟷ ((⋃ i ∈ {i. Inl (Inr i) ∈ SIGO θ}. FVT (σ i)) ∩ U) = {}"
inductive OadmitFO :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'c) ODE ⇒ ('c + 'c) set ⇒ bool"
where
OadmitFO_OVar:"OUadmitFO σ (OVar c) U ⟹ OadmitFO σ (OVar c) U"
| OadmitFO_OSing:"OUadmitFO σ (OSing x θ) U ⟹ TadmitFFO σ θ ⟹ OadmitFO σ (OSing x θ) U"
| OadmitFO_OProd:"OadmitFO σ ODE1 U ⟹ OadmitFO σ ODE2 U ⟹ OadmitFO σ (OProd ODE1 ODE2) U"
inductive_simps
OadmitFO_OVar_simps[simp]: "OadmitFO σ (OVar a) U"
and OadmitFO_OProd_simps[simp]: "OadmitFO σ (OProd ODE1 ODE2) U"
and OadmitFO_OSing_simps[simp]: "OadmitFO σ (OSing x e) U"
definition FUadmitFO :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'b, 'c) formula ⇒ ('c + 'c) set ⇒ bool"
where "FUadmitFO σ θ U ⟷ ((⋃ i ∈ {i. Inl (Inr i) ∈ SIGF θ}. FVT (σ i)) ∩ U) = {}"
definition PUadmitFO :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'b, 'c) hp ⇒ ('c + 'c) set ⇒ bool"
where "PUadmitFO σ θ U ⟷ ((⋃ i ∈ {i. Inl (Inr i) ∈ SIGP θ}. FVT (σ i)) ∩ U) = {}"
inductive NPadmit :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'b, 'c) hp ⇒ bool"
and NFadmit :: "('d ⇒ ('a, 'c) trm) ⇒ ('a + 'd, 'b, 'c) formula ⇒ bool"
where
NPadmit_Pvar:"NPadmit σ (Pvar a)"
| NPadmit_Sequence:"NPadmit σ a ⟹ NPadmit σ b ⟹ PUadmitFO σ b (BVP (PsubstFO a σ))⟹ hpsafe (PsubstFO a σ) ⟹ NPadmit σ (Sequence a b)"
| NPadmit_Loop:"NPadmit σ a ⟹ PUadmitFO σ a (BVP (PsubstFO a σ)) ⟹ hpsafe (PsubstFO a σ) ⟹ NPadmit σ (Loop a)"
| NPadmit_ODE:"OadmitFO σ ODE (BVO ODE) ⟹ NFadmit σ φ ⟹ FUadmitFO σ φ (BVO ODE) ⟹ fsafe (FsubstFO φ σ) ⟹ osafe (OsubstFO ODE σ) ⟹ NPadmit σ (EvolveODE ODE φ)"
| NPadmit_Choice:"NPadmit σ a ⟹ NPadmit σ b ⟹ NPadmit σ (Choice a b)"
| NPadmit_Assign:"TadmitFO σ θ ⟹ NPadmit σ (Assign x θ)"
| NPadmit_DiffAssign:"TadmitFO σ θ ⟹ NPadmit σ (DiffAssign x θ)"
| NPadmit_Test:"NFadmit σ φ ⟹ NPadmit σ (Test φ)"
| NFadmit_Geq:"TadmitFO σ θ1 ⟹ TadmitFO σ θ2 ⟹ NFadmit σ (Geq θ1 θ2)"
| NFadmit_Prop:"(⋀i. TadmitFO σ (args i)) ⟹ NFadmit σ (Prop f args)"
| NFadmit_Not:"NFadmit σ φ ⟹ NFadmit σ (Not φ)"
| NFadmit_And:"NFadmit σ φ ⟹ NFadmit σ ψ ⟹ NFadmit σ (And φ ψ)"
| NFadmit_Exists:"NFadmit σ φ ⟹ FUadmitFO σ φ {Inl x} ⟹ NFadmit σ (Exists x φ)"
| NFadmit_Diamond:"NFadmit σ φ ⟹ NPadmit σ a ⟹ FUadmitFO σ φ (BVP (PsubstFO a σ)) ⟹ hpsafe (PsubstFO a σ) ⟹ NFadmit σ (Diamond a φ)"
| NFadmit_Context:"NFadmit σ φ ⟹ FUadmitFO σ φ UNIV ⟹ NFadmit σ (InContext C φ)"
inductive_simps
NPadmit_Pvar_simps[simp]: "NPadmit σ (Pvar a)"
and NPadmit_Sequence_simps[simp]: "NPadmit σ (a ;; b)"
and NPadmit_Loop_simps[simp]: "NPadmit σ (a**)"
and NPadmit_ODE_simps[simp]: "NPadmit σ (EvolveODE ODE p)"
and NPadmit_Choice_simps[simp]: "NPadmit σ (a ∪∪ b)"
and NPadmit_Assign_simps[simp]: "NPadmit σ (Assign x e)"
and NPadmit_DiffAssign_simps[simp]: "NPadmit σ (DiffAssign x e)"
and NPadmit_Test_simps[simp]: "NPadmit σ (? p)"
and NFadmit_Geq_simps[simp]: "NFadmit σ (Geq t1 t2)"
and NFadmit_Prop_simps[simp]: "NFadmit σ (Prop p args)"
and NFadmit_Not_simps[simp]: "NFadmit σ (Not p)"
and NFadmit_And_simps[simp]: "NFadmit σ (And p q)"
and NFadmit_Exists_simps[simp]: "NFadmit σ (Exists x p)"
and NFadmit_Diamond_simps[simp]: "NFadmit σ (Diamond a p)"
and NFadmit_Context_simps[simp]: "NFadmit σ (InContext C p)"
definition PFUadmit :: "('d ⇒ ('a, 'b, 'c) formula) ⇒ ('a, 'b + 'd, 'c) formula ⇒ ('c + 'c) set ⇒ bool"
where "PFUadmit σ θ U ⟷ True"
definition PPUadmit :: "('d ⇒ ('a, 'b, 'c) formula) ⇒ ('a, 'b + 'd, 'c) hp ⇒ ('c + 'c) set ⇒ bool"
where "PPUadmit σ θ U ⟷ ((⋃ i. FVF (σ i)) ∩ U) = {}"
inductive PPadmit:: "('d ⇒ ('a, 'b, 'c) formula) ⇒ ('a, 'b + 'd, 'c) hp ⇒ bool"
and PFadmit:: "('d ⇒ ('a, 'b, 'c) formula) ⇒ ('a, 'b + 'd, 'c) formula ⇒ bool"
where
PPadmit_Pvar:"PPadmit σ (Pvar a)"
| PPadmit_Sequence:"PPadmit σ a ⟹ PPadmit σ b ⟹ PPUadmit σ b (BVP (PPsubst a σ))⟹ hpsafe (PPsubst a σ) ⟹ PPadmit σ (Sequence a b)"
| PPadmit_Loop:"PPadmit σ a ⟹ PPUadmit σ a (BVP (PPsubst a σ)) ⟹ hpsafe (PPsubst a σ) ⟹ PPadmit σ (Loop a)"
| PPadmit_ODE:"PFadmit σ φ ⟹ PFUadmit σ φ (BVO ODE) ⟹ PPadmit σ (EvolveODE ODE φ)"
| PPadmit_Choice:"PPadmit σ a ⟹ PPadmit σ b ⟹ PPadmit σ (Choice a b)"
| PPadmit_Assign:"PPadmit σ (Assign x θ)"
| PPadmit_DiffAssign:"PPadmit σ (DiffAssign x θ)"
| PPadmit_Test:"PFadmit σ φ ⟹ PPadmit σ (Test φ)"
| PFadmit_Geq:"PFadmit σ (Geq θ1 θ2)"
| PFadmit_Prop:"PFadmit σ (Prop f args)"
| PFadmit_Not:"PFadmit σ φ ⟹ PFadmit σ (Not φ)"
| PFadmit_And:"PFadmit σ φ ⟹ PFadmit σ ψ ⟹ PFadmit σ (And φ ψ)"
| PFadmit_Exists:"PFadmit σ φ ⟹ PFUadmit σ φ {Inl x} ⟹ PFadmit σ (Exists x φ)"
| PFadmit_Diamond:"PFadmit σ φ ⟹ PPadmit σ a ⟹ PFUadmit σ φ (BVP (PPsubst a σ)) ⟹ PFadmit σ (Diamond a φ)"
| PFadmit_Context:"PFadmit σ φ ⟹ PFUadmit σ φ UNIV ⟹ PFadmit σ (InContext C φ)"
inductive_simps
PPadmit_Pvar_simps[simp]: "PPadmit σ (Pvar a)"
and PPadmit_Sequence_simps[simp]: "PPadmit σ (a ;; b)"
and PPadmit_Loop_simps[simp]: "PPadmit σ (a**)"
and PPadmit_ODE_simps[simp]: "PPadmit σ (EvolveODE ODE p)"
and PPadmit_Choice_simps[simp]: "PPadmit σ (a ∪∪ b)"
and PPadmit_Assign_simps[simp]: "PPadmit σ (Assign x e)"
and PPadmit_DiffAssign_simps[simp]: "PPadmit σ (DiffAssign x e)"
and PPadmit_Test_simps[simp]: "PPadmit σ (? p)"
and PFadmit_Geq_simps[simp]: "PFadmit σ (Geq t1 t2)"
and PFadmit_Prop_simps[simp]: "PFadmit σ (Prop p args)"
and PFadmit_Not_simps[simp]: "PFadmit σ (Not p)"
and PFadmit_And_simps[simp]: "PFadmit σ (And p q)"
and PFadmit_Exists_simps[simp]: "PFadmit σ (Exists x p)"
and PFadmit_Diamond_simps[simp]: "PFadmit σ (Diamond a p)"
and PFadmit_Context_simps[simp]: "PFadmit σ (InContext C p)"
inductive Padmit:: "('a, 'b, 'c) subst ⇒ ('a, 'b, 'c) hp ⇒ bool"
and Fadmit:: "('a, 'b, 'c) subst ⇒ ('a, 'b, 'c) formula ⇒ bool"
where
Padmit_Pvar:"Padmit σ (Pvar a)"
| Padmit_Sequence:"Padmit σ a ⟹ Padmit σ b ⟹ PUadmit σ b (BVP (Psubst a σ))⟹ hpsafe (Psubst a σ) ⟹ Padmit σ (Sequence a b)"
| Padmit_Loop:"Padmit σ a ⟹ PUadmit σ a (BVP (Psubst a σ)) ⟹ hpsafe (Psubst a σ) ⟹ Padmit σ (Loop a)"
| Padmit_ODE:"Oadmit σ ODE (BVO ODE) ⟹ Fadmit σ φ ⟹ FUadmit σ φ (BVO ODE) ⟹ Padmit σ (EvolveODE ODE φ)"
| Padmit_Choice:"Padmit σ a ⟹ Padmit σ b ⟹ Padmit σ (Choice a b)"
| Padmit_Assign:"Tadmit σ θ ⟹ Padmit σ (Assign x θ)"
| Padmit_DiffAssign:"Tadmit σ θ ⟹ Padmit σ (DiffAssign x θ)"
| Padmit_Test:"Fadmit σ φ ⟹ Padmit σ (Test φ)"
| Fadmit_Geq:"Tadmit σ θ1 ⟹ Tadmit σ θ2 ⟹ Fadmit σ (Geq θ1 θ2)"
| Fadmit_Prop1:"(⋀i. Tadmit σ (args i)) ⟹ SPredicates σ p = Some p' ⟹ NFadmit (λ i. Tsubst (args i) σ) p' ⟹ (⋀i. dsafe (Tsubst (args i) σ))⟹ Fadmit σ (Prop p args)"
| Fadmit_Prop2:"(⋀i. Tadmit σ (args i)) ⟹ SPredicates σ p = None ⟹ Fadmit σ (Prop p args)"
| Fadmit_Not:"Fadmit σ φ ⟹ Fadmit σ (Not φ)"
| Fadmit_And:"Fadmit σ φ ⟹ Fadmit σ ψ ⟹ Fadmit σ (And φ ψ)"
| Fadmit_Exists:"Fadmit σ φ ⟹ FUadmit σ φ {Inl x} ⟹ Fadmit σ (Exists x φ)"
| Fadmit_Diamond:"Fadmit σ φ ⟹ Padmit σ a ⟹ FUadmit σ φ (BVP (Psubst a σ)) ⟹ hpsafe (Psubst a σ) ⟹ Fadmit σ (Diamond a φ)"
| Fadmit_Context1:"Fadmit σ φ ⟹ FUadmit σ φ UNIV ⟹ SContexts σ C = Some C' ⟹ PFadmit (λ _. Fsubst φ σ) C' ⟹ fsafe(Fsubst φ σ) ⟹ Fadmit σ (InContext C φ)"
| Fadmit_Context2:"Fadmit σ φ ⟹ FUadmit σ φ UNIV ⟹ SContexts σ C = None ⟹ Fadmit σ (InContext C φ)"
inductive_simps
Padmit_Pvar_simps[simp]: "Padmit σ (Pvar a)"
and Padmit_Sequence_simps[simp]: "Padmit σ (a ;; b)"
and Padmit_Loop_simps[simp]: "Padmit σ (a**)"
and Padmit_ODE_simps[simp]: "Padmit σ (EvolveODE ODE p)"
and Padmit_Choice_simps[simp]: "Padmit σ (a ∪∪ b)"
and Padmit_Assign_simps[simp]: "Padmit σ (Assign x e)"
and Padmit_DiffAssign_simps[simp]: "Padmit σ (DiffAssign x e)"
and Padmit_Test_simps[simp]: "Padmit σ (? p)"
and Fadmit_Geq_simps[simp]: "Fadmit σ (Geq t1 t2)"
and Fadmit_Prop_simps[simp]: "Fadmit σ (Prop p args)"
and Fadmit_Not_simps[simp]: "Fadmit σ (Not p)"
and Fadmit_And_simps[simp]: "Fadmit σ (And p q)"
and Fadmit_Exists_simps[simp]: "Fadmit σ (Exists x p)"
and Fadmit_Diamond_simps[simp]: "Fadmit σ (Diamond a p)"
and Fadmit_Context_simps[simp]: "Fadmit σ (InContext C p)"
fun extendf :: "('sf, 'sc, 'sz) interp ⇒ 'sz Rvec ⇒ ('sf + 'sz, 'sc, 'sz) interp"
where "extendf I R =
⦇Functions = (λf. case f of Inl f' ⇒ Functions I f' | Inr f' ⇒ (λ_. R $ f')),
Predicates = Predicates I,
Contexts = Contexts I,
Programs = Programs I,
ODEs = ODEs I,
ODEBV = ODEBV I
⦈"
fun extendc :: "('sf, 'sc, 'sz) interp ⇒ 'sz state set ⇒ ('sf, 'sc + unit, 'sz) interp"
where "extendc I R =
⦇Functions = Functions I,
Predicates = Predicates I,
Contexts = (λC. case C of Inl C' ⇒ Contexts I C' | Inr () ⇒ (λ_. R)),
Programs = Programs I,
ODEs = ODEs I,
ODEBV = ODEBV I⦈"
definition adjoint :: "('sf, 'sc, 'sz) interp ⇒ ('sf, 'sc, 'sz) subst ⇒ 'sz state ⇒ ('sf, 'sc, 'sz) interp"
where "adjoint I σ ν =
⦇Functions = (λf. case SFunctions σ f of Some f' ⇒ (λR. dterm_sem (extendf I R) f' ν) | None ⇒ Functions I f),
Predicates = (λp. case SPredicates σ p of Some p' ⇒ (λR. ν ∈ fml_sem (extendf I R) p') | None ⇒ Predicates I p),
Contexts = (λc. case SContexts σ c of Some c' ⇒ (λR. fml_sem (extendc I R) c') | None ⇒ Contexts I c),
Programs = (λa. case SPrograms σ a of Some a' ⇒ prog_sem I a' | None ⇒ Programs I a),
ODEs = (λode. case SODEs σ ode of Some ode' ⇒ ODE_sem I ode' | None ⇒ ODEs I ode),
ODEBV = (λode. case SODEs σ ode of Some ode' ⇒ ODE_vars I ode' | None ⇒ ODEBV I ode)
⦈"
lemma dsem_to_ssem:"dfree θ ⟹ dterm_sem I θ ν = sterm_sem I θ (fst ν)"
by (induct rule: dfree.induct) (auto)
definition adjointFO::"('sf, 'sc, 'sz) interp ⇒ ('d::finite ⇒ ('sf, 'sz) trm) ⇒ 'sz state ⇒ ('sf + 'd, 'sc, 'sz) interp"
where "adjointFO I σ ν =
⦇Functions = (λf. case f of Inl f' ⇒ Functions I f' | Inr f' ⇒ (λ_. dterm_sem I (σ f') ν)),
Predicates = Predicates I,
Contexts = Contexts I,
Programs = Programs I,
ODEs = ODEs I,
ODEBV = ODEBV I
⦈"
lemma adjoint_free:
assumes sfree:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
shows "adjoint I σ ν =
⦇Functions = (λf. case SFunctions σ f of Some f' ⇒ (λR. sterm_sem (extendf I R) f' (fst ν)) | None ⇒ Functions I f),
Predicates = (λp. case SPredicates σ p of Some p' ⇒ (λR. ν ∈ fml_sem (extendf I R) p') | None ⇒ Predicates I p),
Contexts = (λc. case SContexts σ c of Some c' ⇒ (λR. fml_sem (extendc I R) c') | None ⇒ Contexts I c),
Programs = (λa. case SPrograms σ a of Some a' ⇒ prog_sem I a' | None ⇒ Programs I a),
ODEs = (λode. case SODEs σ ode of Some ode' ⇒ ODE_sem I ode' | None ⇒ ODEs I ode),
ODEBV = (λode. case SODEs σ ode of Some ode' ⇒ ODE_vars I ode' | None ⇒ ODEBV I ode)⦈"
using dsem_to_ssem[OF sfree]
by (cases ν) (auto simp add: adjoint_def fun_eq_iff split: option.split)
lemma adjointFO_free:"(⋀i. dfree (σ i)) ⟹ (adjointFO I σ ν =
⦇Functions = (λf. case f of Inl f' ⇒ Functions I f' | Inr f' ⇒ (λ_. sterm_sem I (σ f') (fst ν))),
Predicates = Predicates I,
Contexts = Contexts I,
Programs = Programs I,
ODEs = ODEs I,
ODEBV = ODEBV I⦈)"
by (auto simp add: dsem_to_ssem adjointFO_def)
definition PFadjoint::"('sf, 'sc, 'sz) interp ⇒ ('d::finite ⇒ ('sf, 'sc, 'sz) formula) ⇒ ('sf, 'sc + 'd, 'sz) interp"
where "PFadjoint I σ =
⦇Functions = Functions I,
Predicates = Predicates I,
Contexts = (λf. case f of Inl f' ⇒ Contexts I f' | Inr f' ⇒ (λ_. fml_sem I (σ f'))),
Programs = Programs I,
ODEs = ODEs I,
ODEBV = ODEBV I⦈"
fun Ssubst::"('sf, 'sc, 'sz) sequent ⇒ ('sf,'sc,'sz) subst ⇒ ('sf,'sc,'sz) sequent"
where "Ssubst (Γ,Δ) σ = (map (λ φ. Fsubst φ σ) Γ, map (λ φ. Fsubst φ σ) Δ)"
fun Rsubst::"('sf, 'sc, 'sz) rule ⇒ ('sf,'sc,'sz) subst ⇒ ('sf,'sc,'sz) rule"
where "Rsubst (SG,C) σ = (map (λ φ. Ssubst φ σ) SG, Ssubst C σ)"
definition Sadmit::"('sf,'sc,'sz) subst ⇒ ('sf,'sc,'sz) sequent ⇒ bool"
where "Sadmit σ S ⟷ ((∀i. i ≥ 0 ⟶ i < length (fst S) ⟶ Fadmit σ (nth (fst S) i))
∧(∀i. i ≥ 0 ⟶ i < length (snd S) ⟶ Fadmit σ (nth (snd S) i)))"
definition Radmit::"('sf,'sc,'sz) subst ⇒ ('sf,'sc,'sz) rule ⇒ bool"
where "Radmit σ R ⟷ (((∀i. i ≥ 0 ⟶ i < length (fst R) ⟶ Sadmit σ (nth (fst R) i))
∧ Sadmit σ (snd R)))"
end end
Theory USubst_Lemma
theory "USubst_Lemma"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Frechet_Correctness"
"Static_Semantics"
"Coincidence"
"Bound_Effect"
"USubst"
begin context ids begin
section ‹Soundness proof for uniform substitution rule›
lemma interp_eq:
"f = f' ⟹ p = p' ⟹ c = c' ⟹ PP = PP' ⟹ ode = ode' ⟹ odebv = odebv' ⟹
⦇Functions = f, Predicates = p, Contexts = c, Programs = PP, ODEs = ode, ODEBV = odebv⦈ =
⦇Functions = f', Predicates = p', Contexts = c', Programs = PP', ODEs = ode', ODEBV = odebv'⦈"
by auto
subsection ‹Lemmas about well-formedness of (adjoint) interpretations.›
text ‹When adding a function to an interpretation with {\tt extendf}, we need to show it's C1 continuous.
We do this by explicitly constructing the derivative {\tt extendf\_deriv} and showing it's continuous.›
primrec extendf_deriv :: "('sf,'sc,'sz) interp ⇒ 'sf ⇒ ('sf + 'sz,'sz) trm ⇒ 'sz state ⇒ 'sz Rvec ⇒ ('sz Rvec ⇒ real)"
where
"extendf_deriv I _ (Var i) ν x = (λ_. 0)"
| "extendf_deriv I _ (Const r) ν x = (λ_. 0)"
| "extendf_deriv I g (Function f args) ν x =
(case f of
Inl ff ⇒ (THE f'. ∀y. (Functions I ff has_derivative f' y) (at y))
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν) ∘
(λν'. χ ia. extendf_deriv I g (args ia) ν x ν')
| Inr ff ⇒ (λ ν'. ν' $ ff))"
| "extendf_deriv I g (Plus t1 t2) ν x = (λν'. (extendf_deriv I g t1 ν x ν') + (extendf_deriv I g t2 ν x ν'))"
| "extendf_deriv I g (Times t1 t2) ν x =
(λν'. ((dterm_sem (extendf I x) t1 ν * (extendf_deriv I g t2 ν x ν')))
+ (extendf_deriv I g t1 ν x ν') * (dterm_sem (extendf I x) t2 ν))"
| "extendf_deriv I g ($' _) ν = undefined"
| "extendf_deriv I g (Differential _) ν = undefined"
lemma extendf_dterm_sem_continuous:
fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
assumes free:"dfree f'"
assumes good_interp:"is_interp I"
shows "continuous_on UNIV (λx. dterm_sem (extendf I x) f' ν)"
proof(induction rule: dfree.induct[OF free])
case (3 args f)
then show ?case
apply(cases f)
apply (auto simp add: continuous_intros)
subgoal for a
apply(rule continuous_on_compose2[of UNIV "Functions I a" UNIV "(λ x. (χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I,
Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν))"])
subgoal
using is_interpD[OF good_interp]
using has_derivative_continuous_on[of UNIV "(Functions I a)" "(THE f'. ∀x. (Functions I a has_derivative f' x) (at x))"]
by auto
apply(rule continuous_on_vec_lambda) by auto
done
qed (auto simp add: continuous_intros)
lemma extendf_deriv_bounded:
fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
assumes free:"dfree f'"
assumes good_interp:"is_interp I"
shows "bounded_linear (extendf_deriv I i f' ν x)"
proof(induction rule: dfree.induct[OF free])
case (1 i)
then show ?case by auto
next
case (2 r)
then show ?case by auto
next
case (3 args f)
then show ?case apply auto
apply(cases f)
apply auto
subgoal for a
apply(rule bounded_linear_compose[of "(THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν)"])
subgoal using good_interp unfolding is_interp_def using has_derivative_bounded_linear by fastforce
apply(rule bounded_linear_vec)
by auto
done
next
case (4 θ⇩1 θ⇩2)
then show ?case apply auto
using bounded_linear_add by blast
next
case (5 θ⇩1 θ⇩2)
then show ?case apply auto
apply(rule bounded_linear_add)
apply(rule bounded_linear_const_mult)
subgoal by auto
apply(rule bounded_linear_mult_const)
subgoal by auto
done
qed
lemma extendf_deriv_continuous:
fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
assumes free:"dfree f'"
assumes good_interp:"is_interp I"
shows "continuous_on UNIV (λx. Blinfun (extendf_deriv I i f' ν x))"
proof (induction rule: dfree.induct[OF free])
case (3 args f)
assume dfrees:"⋀i. dfree (args i)"
assume const:"⋀j. continuous_on UNIV (λx. Blinfun (extendf_deriv I i (args j) ν x))"
then show ?case
unfolding extendf_deriv.simps
apply(cases f)
subgoal for a
apply simp
proof -
have boundedF:"⋀x. bounded_linear (((THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem (extendf I x) (args i) ν) ))"
using blinfun.bounded_linear_right using good_interp unfolding is_interp_def
by auto
have boundedG:"⋀x. bounded_linear (λ b. (χ ia. extendf_deriv I i (args ia) ν x b))"
by (simp add: bounded_linear_vec dfrees extendf_deriv_bounded good_interp)
have boundedH:"⋀x. bounded_linear (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem
(extendf I x)
(args i) ν)
(χ ia. extendf_deriv I i (args ia) ν x b))"
using bounded_linear_compose boundedG boundedF by blast
have eq:"(λx. Blinfun (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem
(extendf I x)
(args i) ν)
(χ ia. extendf_deriv I i (args ia) ν x b)))
=
(λx. blinfun_compose(Blinfun((THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem
(extendf I x)
(args i) ν) )) (Blinfun(λ b. (χ ia. extendf_deriv I i (args ia) ν x b))))"
apply(rule ext)
apply(rule blinfun_eqI)
subgoal for x ia
using boundedG[of x] blinfun_apply_blinfun_compose bounded_linear_Blinfun_apply
proof -
have f1: "bounded_linear (λv. FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν) (χ s. extendf_deriv I i (args s) ν x v))"
using FunctionFrechet.simps ‹bounded_linear (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y)) (χ i. dterm_sem (extendf I x) (args i) ν) (χ ia. extendf_deriv I i (args ia) ν x b))›
by fastforce
have "bounded_linear (FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν))"
using good_interp is_interp_def by blast
then have "blinfun_apply (Blinfun (FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν))) (χ s. extendf_deriv I i (args s) ν x ia) = blinfun_apply (Blinfun (λv. FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν) (χ s. extendf_deriv I i (args s) ν x v))) ia"
using f1 by (simp add: bounded_linear_Blinfun_apply)
then have "blinfun_apply (Blinfun (FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν))) (χ s. extendf_deriv I i (args s) ν x ia) = blinfun_apply (Blinfun (λv. FunctionFrechet I a (χ s. dterm_sem (extendf I x) (args s) ν) (χ s. extendf_deriv I i (args s) ν x v))) ia ∧ bounded_linear (λv. χ s. extendf_deriv I i (args s) ν x v)"
by (metis ‹bounded_linear (λb. χ ia. extendf_deriv I i (args ia) ν x b)›)
then show ?thesis
by (simp add: bounded_linear_Blinfun_apply)
qed
done
have bounds:"⋀ia x. bounded_linear (extendf_deriv I i (args ia) ν x)"
by (simp add: dfrees extendf_deriv_bounded good_interp)
have vec_bound:"⋀x. bounded_linear (λb. χ ia. extendf_deriv I i (args ia) ν x b)"
by (simp add: boundedG)
have blinfun_vec:"(λx. Blinfun (λb. χ ia. extendf_deriv I i (args ia) ν x b)) = (λx. blinfun_vec (λ ia. Blinfun(λb. extendf_deriv I i (args ia) ν x b)))"
apply(rule ext)
apply(rule blinfun_eqI)
apply(rule vec_extensionality)
subgoal for x y ia
proof -
have "(χ s. extendf_deriv I i (args s) ν x y) $ ia = blinfun_apply (blinfun_vec (λs. Blinfun (extendf_deriv I i (args s) ν x))) y $ ia"
by (simp add: bounded_linear_Blinfun_apply bounds)
then have "(χ s. extendf_deriv I i (args s) ν x y) $ ia = blinfun_apply (blinfun_vec (λs. Blinfun (extendf_deriv I i (args s) ν x))) y $ ia ∧ bounded_linear (λv. χ s. extendf_deriv I i (args s) ν x v)"
by (metis ‹bounded_linear (λb. χ ia. extendf_deriv I i (args ia) ν x b)›)
then show ?thesis
by (simp add: bounded_linear_Blinfun_apply)
qed
done
have vec_cont:"continuous_on UNIV (λx. blinfun_vec (λ ia. Blinfun(λb. extendf_deriv I i (args ia) ν x b)))"
apply(rule continuous_blinfun_vec')
using "3.IH" by blast
have cont_intro:"⋀ f g s. continuous_on s f ⟹ continuous_on s g ⟹ continuous_on s (λx. f x o⇩L g x)"
by(auto intro: continuous_intros)
have cont:"continuous_on UNIV (λx. blinfun_compose(Blinfun((THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I,
Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν) )) (Blinfun(λ b. (χ ia. extendf_deriv I i (args ia) ν x b))))"
apply(rule cont_intro)
defer
subgoal using blinfun_vec vec_cont by presburger
apply(rule continuous_on_compose2[of UNIV "(λx. Blinfun ((THE f'. ∀y. (Functions I a has_derivative f' y) (at y)) x))"])
subgoal using good_interp unfolding is_interp_def by simp
apply(rule continuous_on_vec_lambda)
subgoal for i using extendf_dterm_sem_continuous[OF dfrees[of i] good_interp] by auto
by auto
then show " continuous_on UNIV
(λx. Blinfun (λb. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I,
Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν)
(χ ia. extendf_deriv I i (args ia) ν x b)))"
using eq apply simp by presburger
qed
by simp
next
case (4 θ⇩1 θ⇩2)
assume free1:"dfree θ⇩1"
assume free2:"dfree θ⇩2"
assume IH1:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩1 ν x))"
assume IH2:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩2 ν x))"
have bound:"⋀x. bounded_linear (λa. extendf_deriv I i θ⇩1 ν x a + extendf_deriv I i θ⇩2 ν x a)"
using extendf_deriv_bounded[OF free1 good_interp] extendf_deriv_bounded[OF free2 good_interp]
by (simp add: bounded_linear_add)
have eq:"(λx. Blinfun (λa. extendf_deriv I i θ⇩1 ν x a + extendf_deriv I i θ⇩2 ν x a)) = (λx. Blinfun (λa. extendf_deriv I i θ⇩1 ν x a) + Blinfun (λa. extendf_deriv I i θ⇩2 ν x a))"
apply(rule ext)
apply(rule blinfun_eqI)
subgoal for x j
using bound[of x] extendf_deriv_bounded[OF free1 good_interp]
extendf_deriv_bounded[OF free2 good_interp]
blinfun.add_left[of "Blinfun (extendf_deriv I i θ⇩1 ν x)" "Blinfun (extendf_deriv I i θ⇩2 ν x)"]
bounded_linear_Blinfun_apply[of "(extendf_deriv I i θ⇩1 ν x)"]
bounded_linear_Blinfun_apply[of "(extendf_deriv I i θ⇩2 ν x)"]
by (simp add: bounded_linear_Blinfun_apply)
done
have "continuous_on UNIV (λx. Blinfun (λa. extendf_deriv I i θ⇩1 ν x a) + Blinfun (λa. extendf_deriv I i θ⇩2 ν x a))"
apply(rule continuous_intros)
using IH1 IH2 by auto
then show ?case
apply simp
using eq by presburger
next
case (5 θ⇩1 θ⇩2)
assume free1:"dfree θ⇩1"
assume free2:"dfree θ⇩2"
assume IH1:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩1 ν x))"
assume IH2:"continuous_on UNIV (λx. Blinfun (extendf_deriv I i θ⇩2 ν x))"
have bounded:"⋀x. bounded_linear (λa. dterm_sem (extendf I x) θ⇩1 ν * extendf_deriv I i θ⇩2 ν x a +
extendf_deriv I i θ⇩1 ν x a * dterm_sem (extendf I x) θ⇩2 ν)"
using extendf_deriv_bounded[OF free1 good_interp] extendf_deriv_bounded[OF free2 good_interp]
by (simp add: bounded_linear_add bounded_linear_const_mult bounded_linear_mult_const)
have eq:"(λx. Blinfun (λa. dterm_sem (extendf I x) θ⇩1 ν * extendf_deriv I i θ⇩2 ν x a +
extendf_deriv I i θ⇩1 ν x a * dterm_sem (extendf I x) θ⇩2 ν)) =
(λx. dterm_sem (extendf I x) θ⇩1 ν *⇩R Blinfun (λa. extendf_deriv I i θ⇩2 ν x a) +
dterm_sem (extendf I x) θ⇩2 ν *⇩R Blinfun (λa. extendf_deriv I i θ⇩1 ν x a))"
apply(rule ext)
apply(rule blinfun_eqI)
subgoal for x j
using extendf_deriv_bounded[OF free1 good_interp] extendf_deriv_bounded[OF free2 good_interp] bounded[of x]
blinfun.scaleR_left
bounded_linear_Blinfun_apply[of "Blinfun (extendf_deriv I i θ⇩2 ν x)"]
bounded_linear_Blinfun_apply[of "Blinfun (extendf_deriv I i θ⇩1 ν x)"]
mult.commute
plus_blinfun.rep_eq[of "dterm_sem (extendf I x) θ⇩1 ν *⇩R Blinfun (extendf_deriv I i θ⇩2 ν x)" "dterm_sem (extendf I x) θ⇩2 ν *⇩R Blinfun (extendf_deriv I i θ⇩1 ν x)"]
real_scaleR_def
by (simp add: blinfun.scaleR_left bounded_linear_Blinfun_apply)
done
have "continuous_on UNIV (λx. dterm_sem (extendf I x) θ⇩1 ν *⇩R Blinfun (λa. extendf_deriv I i θ⇩2 ν x a) +
dterm_sem (extendf I x) θ⇩2 ν *⇩R Blinfun (λa. extendf_deriv I i θ⇩1 ν x a))"
apply(rule continuous_intros)+
apply(rule extendf_dterm_sem_continuous[OF free1 good_interp])
apply(rule IH2)
apply(rule continuous_intros)+
apply(rule extendf_dterm_sem_continuous[OF free2 good_interp])
by(rule IH1)
then show ?case
unfolding extendf_deriv.simps
using eq by presburger
qed (auto intro: continuous_intros)
lemma extendf_deriv:
fixes f'::"('sf + 'sz,'sz) trm" and I::"('sf,'sc,'sz) interp"
assumes free:"dfree f'"
assumes good_interp:"is_interp I"
shows "∃f''. ∀x. ((λR. dterm_sem (extendf I R) f' ν) has_derivative (extendf_deriv I i_f f' ν x)) (at x)"
using free apply (induction rule: dfree.induct)
apply(auto)+
defer
subgoal for θ⇩1 θ⇩2 x
apply(rule has_derivative_mult)
by auto
subgoal for args i x
apply(cases "i")
defer
apply auto
subgoal for b using has_derivative_proj' by blast
subgoal for a
proof -
assume dfrees:"(⋀i. dfree (args i))"
assume IH1:"(⋀ia. ∀x. ((λR. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
(args ia) ν) has_derivative
extendf_deriv I i_f (args ia) ν x)
(at x))"
then have IH1':"(⋀ia. ⋀x. ((λR. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
(args ia) ν) has_derivative
extendf_deriv I i_f (args ia) ν x)
(at x))"
by auto
assume a:"i = Inl a"
have chain:"⋀f f' x s g g'. (f has_derivative f') (at x within s) ⟹
(g has_derivative g') (at (f x) within f ` s) ⟹ (g ∘ f has_derivative g' ∘ f') (at x within s)"
by (auto intro: derivative_intros)
let ?f = "(λx. Functions I a x)"
let ?g = "(λ R. (χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I,
Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν))"
let ?myf' = "(λx. (THE f'. ∀y. (Functions I a has_derivative f' y) (at y)) (?g x))"
let ?myg' = "(λx. (λν'. χ ia. extendf_deriv I i_f (args ia) ν x ν'))"
have fg_eq:"(λR. Functions I a
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν)) = (?f ∘ ?g)"
by auto
have "∀x. ((?f o ?g) has_derivative (?myf' x ∘ ?myg' x)) (at x)"
apply (rule allI)
apply (rule diff_chain_at)
subgoal for xa
apply (rule has_derivative_vec)
subgoal for i using IH1'[of i xa] by auto
done
subgoal for xa
proof -
have deriv:"⋀x. (Functions I a has_derivative FunctionFrechet I a x) (at x)"
and cont:"continuous_on UNIV (λx. Blinfun (FunctionFrechet I a x))"
using good_interp[unfolded is_interp_def] by auto
show ?thesis
apply(rule has_derivative_at_withinI)
using deriv by auto
qed
done
then have "((?f o ?g) has_derivative (?myf' x ∘ ?myg' x)) (at x)" by auto
then show "((λR. Functions I a
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. R $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν)) has_derivative
(THE f'. ∀y. (Functions I a has_derivative f' y) (at y))
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. x $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν) ∘
(λν'. χ ia. extendf_deriv I i_f (args ia) ν x ν'))
(at x) "
using fg_eq by auto
qed
done
done
lemma adjoint_safe:
assumes good_interp:"is_interp I"
assumes good_subst:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') "
shows "is_interp (adjoint I σ ν)"
apply(unfold adjoint_def)
apply(unfold is_interp_def)
apply(auto simp del: extendf.simps extendc.simps FunctionFrechet.simps)
subgoal for x i
apply(cases "SFunctions σ i = None")
subgoal
apply(auto simp del: extendf.simps extendc.simps)
using good_interp unfolding is_interp_def by simp
apply(auto simp del: extendf.simps extendc.simps)
subgoal for f'
using good_subst[of i f'] apply (auto simp del: extendf.simps extendc.simps)
proof -
assume some:"SFunctions σ i = Some f'"
assume free:"dfree f'"
let ?f = "(λR. dterm_sem (extendf I R) f' ν)"
let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
let ?f''="extendf_deriv I i f' ν"
have Pf:"?Pred ?f''"
using extendf_deriv[OF good_subst[of i f'] good_interp, of ν i, OF some]
by auto
have "(THE G. (?f has_derivative G) (at x)) = ?f'' x"
apply(rule the_deriv)
using Pf by auto
then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
using Pf the_all_deriv by auto
show "((λR. dterm_sem (extendf I R) f' ν) has_derivative (THE f'a. ∀x. ((λR. dterm_sem (extendf I R) f' ν) has_derivative f'a x) (at x)) x) (at x)"
using the_eq Pf by simp
qed
done
subgoal for i
apply(cases "SFunctions σ i = None")
subgoal
apply(auto simp del: extendf.simps extendc.simps)
using good_interp unfolding is_interp_def by simp
apply(auto simp del: extendf.simps extendc.simps)
subgoal for f'
using good_subst[of i f'] apply (auto simp del: extendf.simps extendc.simps)
proof -
assume some:"SFunctions σ i = Some f'"
assume free:"dfree f'"
let ?f = "(λR. dterm_sem (extendf I R) f' ν)"
let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
let ?f''="extendf_deriv I i f' ν"
have Pf:"?Pred ?f''"
using extendf_deriv[OF good_subst[of i f'] good_interp, of ν i, OF some]
by auto
have "⋀x. (THE G. (?f has_derivative G) (at x)) = ?f'' x"
apply(rule the_deriv)
using Pf by auto
then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
using Pf the_all_deriv by auto
have "continuous_on UNIV (λx. Blinfun (?f'' x))"
by(rule extendf_deriv_continuous[OF free good_interp])
show "continuous_on UNIV (λx. Blinfun ((THE f'a. ∀x. ((λR. dterm_sem (extendf I R) f' ν) has_derivative f'a x) (at x)) x))"
using the_eq Pf
by (simp add: ‹continuous_on UNIV (λx. Blinfun (extendf_deriv I i f' ν x))›)
qed
done
done
lemma adjointFO_safe:
assumes good_interp:"is_interp I"
assumes good_subst:"(⋀i. dsafe (σ i))"
shows "is_interp (adjointFO I σ ν)"
apply(unfold adjointFO_def)
apply(unfold is_interp_def)
apply(auto simp del: extendf.simps extendc.simps FunctionFrechet.simps)
subgoal for x i
apply(cases "i")
subgoal
apply(auto simp del: extendf.simps extendc.simps)
using good_interp unfolding is_interp_def by simp
apply(auto simp del: extendf.simps extendc.simps)
subgoal for f'
proof -
assume some:"i = Inr f'"
have free:"dsafe (σ f')" using good_subst by auto
let ?f = "(λ_. dterm_sem I (σ f') ν)"
let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
let ?f''="(λ_ _. 0)"
have Pf:"?Pred ?f''"
proof (induction "σ f'")
qed (auto)
have "(THE G. (?f has_derivative G) (at x)) = ?f'' x"
apply(rule the_deriv)
using Pf by auto
then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
using Pf the_all_deriv[of ?f ?f''] by auto
have another_eq:"(THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x = (λ _. 0)"
using Pf by (simp add: the_eq)
then show "((λ_. dterm_sem I (σ f') ν) has_derivative (THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x) (at x)"
using the_eq Pf by simp
qed
done
subgoal for i
apply(cases i)
subgoal
apply(auto simp del: extendf.simps extendc.simps)
using good_interp unfolding is_interp_def by simp
apply(auto simp del: extendf.simps extendc.simps)
subgoal for f'
using good_subst[of f']
proof -
assume some:"i = Inr f'"
have free:"dsafe (σ f')" using good_subst by auto
let ?f = "(λR. dterm_sem I (σ f') ν)"
let ?Pred = "(λfd. (∀x. (?f has_derivative (fd x)) (at x)))"
let ?f''="(λ_ _. 0)"
have Pf:"?Pred ?f''" by simp
have "⋀x. (THE G. (?f has_derivative G) (at x)) = ?f'' x"
apply(rule the_deriv)
using Pf by auto
then have the_eq:"(THE G. ∀ x. (?f has_derivative G x) (at x)) = ?f''"
using Pf the_all_deriv[of "(λR. dterm_sem I (σ f') ν)" "(λ_ _. 0)"]
by blast
then have blin_cont:"continuous_on UNIV (λx. Blinfun (?f'' x))"
by (simp add: continuous_on_const)
have truth:"(λx. Blinfun ((THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x))
= (λx. Blinfun (λ _. 0))"
apply(rule ext)
apply(rule blinfun_eqI)
by (simp add: local.the_eq)
then show "continuous_on UNIV (λx. Blinfun ((THE f'a. ∀x. ((λ_. dterm_sem I (σ f') ν) has_derivative f'a x) (at x)) x))"
using truth
by (metis (mono_tags, lifting) blin_cont continuous_on_eq)
qed
done
done
subsection ‹Lemmas about adjoint interpretations›
lemma adjoint_consequence:"(⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f') ⟹ (⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f') ⟹ Vagree ν ω (FVS σ) ⟹ adjoint I σ ν = adjoint I σ ω"
apply(unfold FVS_def)
apply(auto)
apply(unfold adjoint_def)
apply(rule interp_eq)
apply(auto simp add: fun_eq_iff)
subgoal for xa xaa
apply(cases "SFunctions σ xa")
apply(auto)
subgoal for a
proof -
assume safes:"(⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f')"
assume agrees:"Vagree ν ω (⋃x. SFV σ x)"
assume some:"SFunctions σ xa = Some a"
from safes some have safe:"dsafe a" by auto
have sub:"SFV σ (Inl xa) ⊆ (⋃x. SFV σ x)"
by blast
from agrees
have "Vagree ν ω (SFV σ (Inl xa))"
using agree_sub[OF sub agrees] by auto
then have agree:"Vagree ν ω (FVT a)"
using some by auto
show "?thesis"
using coincidence_dterm[of a, OF safes[of xa a, OF some] agree] by auto
qed
done
subgoal for xa xaa
apply(cases "SPredicates σ xa")
apply(auto)
subgoal for a
proof -
assume safes:"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
assume agrees:"Vagree ν ω (⋃x. SFV σ x)"
assume some:"SPredicates σ xa = Some a"
assume sem:"ν ∈ fml_sem ⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
a"
from safes some have safe:"fsafe a" by auto
have sub:"SFV σ (Inr (Inr xa)) ⊆ (⋃x. SFV σ x)"
by blast
from agrees
have "Vagree ν ω (SFV σ (Inr (Inr xa)))"
using agree_sub[OF sub agrees] by auto
then have agree:"Vagree ν ω (FVF a)"
using some by auto
let ?I' = "⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈"
have IA:"⋀S. Iagree ?I' ?I' (SIGF a)" using Iagree_refl by auto
show "?thesis"
using coincidence_formula[of a, OF safes[of xa a, OF some] IA agree] sem by auto
qed
done
subgoal for xa xaa
apply(cases "SPredicates σ xa")
apply(auto)
subgoal for a
proof -
assume safes:"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
assume agrees:"Vagree ν ω (⋃x. SFV σ x)"
assume some:"SPredicates σ xa = Some a"
assume sem:"ω ∈ fml_sem ⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈
a"
from safes some have safe:"fsafe a" by auto
have sub:"SFV σ (Inr (Inr xa)) ⊆ (⋃x. SFV σ x)"
by blast
from agrees
have "Vagree ν ω (SFV σ (Inr (Inr xa)))"
using agree_sub[OF sub agrees] by auto
then have agree:"Vagree ν ω (FVF a)"
using some by auto
let ?I' = "⦇Functions = case_sum (Functions I) (λf' _. xaa $ f'), Predicates = Predicates I, Contexts = Contexts I, Programs = Programs I,
ODEs = ODEs I, ODEBV = ODEBV I⦈"
have IA:"⋀S. Iagree ?I' ?I' (SIGF a)" using Iagree_refl by auto
show "?thesis"
using coincidence_formula[of a, OF safes[of xa a, OF some] IA agree] sem by auto
qed
done
done
lemma SIGT_plus1:"Vagree ν ω (⋃i∈SIGT (Plus t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})
⟹ Vagree ν ω (⋃i∈SIGT t1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
unfolding Vagree_def by auto
lemma SIGT_plus2:"Vagree ν ω (⋃i∈SIGT (Plus t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})
⟹ Vagree ν ω (⋃i∈SIGT t2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
unfolding Vagree_def by auto
lemma SIGT_times1:"Vagree ν ω (⋃i∈SIGT (Times t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})
⟹ Vagree ν ω (⋃i∈SIGT t1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
unfolding Vagree_def by auto
lemma SIGT_times2:"Vagree ν ω (⋃i∈SIGT (Times t1 t2). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})
⟹ Vagree ν ω (⋃i∈SIGT t2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
unfolding Vagree_def by auto
lemma uadmit_sterm_adjoint':
assumes dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
shows "Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ sterm_sem (adjoint I σ ν) θ = sterm_sem (adjoint I σ ω) θ"
proof (induct "θ")
case (Plus θ1 θ2)
assume IH1:"Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ1 = sterm_sem (local.adjoint I σ ω) θ1"
assume IH2:"Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ2 = sterm_sem (local.adjoint I σ ω) θ2"
assume VA:"Vagree ν ω (⋃i∈SIGT (Plus θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
then show ?case
using IH1[OF SIGT_plus1[OF VA]] IH2[OF SIGT_plus2[OF VA]] by auto
next
case (Times θ1 θ2)
assume IH1:"Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ1 = sterm_sem (local.adjoint I σ ω) θ1"
assume IH2:"Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ sterm_sem (local.adjoint I σ ν) θ2 = sterm_sem (local.adjoint I σ ω) θ2"
assume VA:"Vagree ν ω (⋃i∈SIGT (Times θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
then show ?case
using IH1[OF SIGT_times1[OF VA]] IH2[OF SIGT_times2[OF VA]] by auto
next
case (Function x1a x2a)
assume IH:"⋀x. x ∈ range x2a ⟹ Vagree ν ω (⋃i∈SIGT x. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
sterm_sem (local.adjoint I σ ν) x = sterm_sem (local.adjoint I σ ω) x"
from IH have IH':"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
sterm_sem (local.adjoint I σ ν) (x2a j) = sterm_sem (local.adjoint I σ ω) (x2a j)"
using rangeI by auto
assume VA:"Vagree ν ω (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
from VA have VAs:"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
unfolding Vagree_def SIGT.simps using rangeI by blast
have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
have VAsub:"⋀a. SFunctions σ x1a = Some a ⟹ (FVT a) ⊆ (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
using SIGT by auto
have VAf:"⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a)"
using agree_sub[OF VAsub VA] by auto
then show ?case
using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
apply(cases "SFunctions σ x1a")
defer
subgoal for x a
proof -
assume VA:"(⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a))"
assume sems:"(⋀j. ∀x. sterm_sem (local.adjoint I σ ν) (x2a j) x = sterm_sem (local.adjoint I σ ω) (x2a j) x)"
assume some:"SFunctions σ x1a = Some a"
note FVT = VAf[OF some]
have dsem:"⋀R . dterm_sem (extendf I R) a ν = dterm_sem (extendf I R) a ω"
using coincidence_dterm[OF dsafe[OF some] FVT] by auto
have "⋀R. Functions (local.adjoint I σ ν) x1a R = Functions (local.adjoint I σ ω) x1a R"
using dsem some unfolding adjoint_def by auto
then show "Functions (local.adjoint I σ ν) x1a (χ i. sterm_sem (local.adjoint I σ ω) (x2a i) x) =
Functions (local.adjoint I σ ω) x1a (χ i. sterm_sem (local.adjoint I σ ω) (x2a i) x)"
by auto
qed
unfolding adjoint_def apply auto
done
qed (auto)
lemma uadmit_sterm_adjoint:
assumes TUA:"TUadmit σ θ U"
assumes VA:"Vagree ν ω (-U)"
assumes dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
shows "sterm_sem (adjoint I σ ν) θ = sterm_sem (adjoint I σ ω) θ"
proof -
have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
by auto
have "⋀x. x ∈ (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ x ∈ (-U)"
using TUA unfolding TUadmit_def by auto
then have sub1:"(⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ -U"
by auto
then have VA':"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
using agree_sub[OF sub1 VA] by auto
then show "?thesis" using uadmit_sterm_adjoint'[OF dsafe fsafe VA'] by auto
qed
lemma uadmit_sterm_ntadjoint':
assumes dsafe:"⋀i. dsafe (σ i)"
shows "Vagree ν ω ((⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))) ⟹ sterm_sem (adjointFO I σ ν) θ = sterm_sem (adjointFO I σ ω) θ"
proof (induct "θ")
case (Plus θ1 θ2)
assume IH1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ1 = sterm_sem (adjointFO I σ ω) θ1"
assume IH2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ2 = sterm_sem (adjointFO I σ ω) θ2"
assume VA:"Vagree ν ω ((⋃ i∈{i. Inr i ∈ SIGT (Plus θ1 θ2)}. FVT (σ i)))"
from VA
have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
and VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))" unfolding Vagree_def by auto
then show ?case
using IH1[OF VA1] IH2[OF VA2] by auto
next
case (Times θ1 θ2)
assume IH1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ1 = sterm_sem (adjointFO I σ ω) θ1"
assume IH2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ sterm_sem (adjointFO I σ ν) θ2 = sterm_sem (adjointFO I σ ω) θ2"
assume VA:"Vagree ν ω ((⋃ i∈{i. Inr i ∈ SIGT (Times θ1 θ2)}. FVT (σ i)))"
from VA
have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
and VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))" unfolding Vagree_def by auto
then show ?case
using IH1[OF VA1] IH2[OF VA2] by auto
next
case (Function x1a x2a)
assume IH:"⋀x. x ∈ range x2a ⟹ Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT x}. FVT (σ i)) ⟹
sterm_sem (adjointFO I σ ν) x = sterm_sem (adjointFO I σ ω) x"
from IH have IH':"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i)) ⟹
sterm_sem (adjointFO I σ ν) (x2a j) = sterm_sem (adjointFO I σ ω) (x2a j)"
using rangeI by auto
assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i)) "
from VA have VAs:"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i))"
unfolding Vagree_def SIGT.simps using rangeI by blast
have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
have VAsub:"⋀a. x1a = Inr a ⟹ (FVT (σ a)) ⊆ (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i))"
using SIGT by auto
have VAf:"⋀a. x1a = Inr a ⟹Vagree ν ω (FVT (σ a))"
using agree_sub[OF VAsub VA] by auto
then show ?case
using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
apply(cases "x1a")
defer
subgoal for x a
proof -
assume VA:"(⋀a. x1a = Inr a ⟹ Vagree ν ω (FVT (σ a)))"
assume sems:"(⋀j. ∀x. sterm_sem (adjointFO I σ ν) (x2a j) x = sterm_sem (adjointFO I σ ω) (x2a j) x)"
assume some:"x1a = Inr a"
note FVT = VAf[OF some]
from dsafe have dsafer:"⋀i. dsafe (σ i)" using dfree_is_dsafe by auto
have dsem:"dterm_sem I (σ a) ν = dterm_sem I (σ a) ω"
using coincidence_dterm[OF dsafer FVT] some by auto
then have "⋀R. Functions (adjointFO I σ ν) x1a R = Functions (adjointFO I σ ω) x1a R"
using some unfolding adjoint_def unfolding adjointFO_def by auto
then show "Functions (adjointFO I σ ν) x1a (χ i. sterm_sem (adjointFO I σ ω) (x2a i) x) =
Functions (adjointFO I σ ω) x1a (χ i. sterm_sem (adjointFO I σ ω) (x2a i) x)"
by auto
qed
unfolding adjointFO_def by auto
qed (auto)
lemma uadmit_sterm_ntadjoint:
assumes TUA:"NTUadmit σ θ U"
assumes VA:"Vagree ν ω (-U)"
assumes dsafe:"⋀i . dsafe (σ i)"
assumes good_interp:"is_interp I"
shows "sterm_sem (adjointFO I σ ν) θ = sterm_sem (adjointFO I σ ω) θ"
proof -
have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
by auto
have "⋀x. x ∈ ((⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))) ⟹ x ∈ (-U)"
using TUA unfolding NTUadmit_def by auto
then have sub1:"(⋃i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⊆ -U"
by auto
then have VA':"Vagree ν ω (⋃i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))"
using agree_sub[OF sub1 VA] by auto
then show "?thesis" using uadmit_sterm_ntadjoint'[OF dsafe VA'] by auto
qed
lemma uadmit_dterm_adjoint':
assumes dfree:"⋀f f'. SFunctions σ f = Some f' ⟹ dfree f'"
assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
assumes good_interp:"is_interp I"
shows "⋀ν ω. Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ dsafe θ ⟹ dterm_sem (adjoint I σ ν) θ = dterm_sem (adjoint I σ ω) θ"
proof (induct "θ")
case (Plus θ1 θ2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ1 ⟹ dterm_sem (local.adjoint I σ ν) θ1 = dterm_sem (local.adjoint I σ ω) θ1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ2 ⟹ dterm_sem (local.adjoint I σ ν) θ2 = dterm_sem (local.adjoint I σ ω) θ2"
assume VA:"Vagree ν ω (⋃i∈SIGT (Plus θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
assume safe:"dsafe (Plus θ1 θ2)"
then show ?case
using IH1[OF SIGT_plus1[OF VA]] IH2[OF SIGT_plus2[OF VA]] by auto
next
case (Times θ1 θ2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ1. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ1 ⟹ dterm_sem (local.adjoint I σ ν) θ1 = dterm_sem (local.adjoint I σ ω) θ1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ2. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ2 ⟹ dterm_sem (local.adjoint I σ ν) θ2 = dterm_sem (local.adjoint I σ ω) θ2"
assume VA:"Vagree ν ω (⋃i∈SIGT (Times θ1 θ2). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
assume safe:"dsafe (Times θ1 θ2)"
then show ?case
using IH1[OF SIGT_times1[OF VA]] IH2[OF SIGT_times2[OF VA]] by auto
next
case (Function x1a x2a)
assume IH:"⋀x. ⋀ν ω. x ∈ range x2a ⟹ Vagree ν ω (⋃i∈SIGT x. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
dsafe x ⟹ dterm_sem (local.adjoint I σ ν) x = dterm_sem (local.adjoint I σ ω) x"
assume safe:"dsafe (Function x1a x2a)"
from safe have safes:"⋀j. dsafe (x2a j)" by auto
from IH have IH':"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹
dterm_sem (local.adjoint I σ ν) (x2a j) = dterm_sem (local.adjoint I σ ω) (x2a j)"
using rangeI safes by auto
assume VA:"Vagree ν ω (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
from VA have VAs:"⋀j. Vagree ν ω (⋃i∈SIGT (x2a j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
unfolding Vagree_def SIGT.simps using rangeI by blast
have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
have VAsub:"⋀a. SFunctions σ x1a = Some a ⟹ (FVT a) ⊆ (⋃i∈SIGT ($f x1a x2a). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
using SIGT by auto
have VAf:"⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a)"
using agree_sub[OF VAsub VA] by auto
then show ?case
using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
apply(cases "SFunctions σ x1a")
defer
subgoal for x1 x2 a
proof -
assume VA:"(⋀a. SFunctions σ x1a = Some a ⟹ Vagree ν ω (FVT a))"
assume sems:"(⋀j. ∀x1 x2. dterm_sem (local.adjoint I σ ν) (x2a j) (x1,x2) = dterm_sem (local.adjoint I σ ω) (x2a j) (x1,x2))"
assume some:"SFunctions σ x1a = Some a"
note FVT = VAf[OF some]
have dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
using dfree dfree_is_dsafe by auto
have dsem:"⋀R . dterm_sem (extendf I R) a ν = dterm_sem (extendf I R) a ω"
using coincidence_dterm[OF dsafe[OF some] FVT] by auto
have "⋀R. Functions (local.adjoint I σ ν) x1a R = Functions (local.adjoint I σ ω) x1a R"
using dsem some unfolding adjoint_def by auto
then show "Functions (local.adjoint I σ ν) x1a (χ i. dterm_sem (local.adjoint I σ ω) (x2a i) (x1,x2)) =
Functions (local.adjoint I σ ω) x1a (χ i. dterm_sem (local.adjoint I σ ω) (x2a i) (x1,x2))"
by auto
qed
unfolding adjoint_def apply auto
done
next
case (Differential θ)
assume IH:"⋀ν ω. Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {}) ⟹ dsafe θ ⟹ dterm_sem (local.adjoint I σ ν) θ = dterm_sem (local.adjoint I σ ω) θ"
assume VA:"Vagree ν ω (⋃i∈SIGT (Differential θ). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
assume safe:"dsafe (Differential θ)"
then have free:"dfree θ" by (auto dest: dsafe.cases)
from VA have VA':"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
by auto
have dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
using dfree dfree_is_dsafe by auto
have sem:"sterm_sem (local.adjoint I σ ν) θ = sterm_sem (local.adjoint I σ ω) θ"
using uadmit_sterm_adjoint'[OF dsafe fsafe VA', of "λ x y. x" "λ x y. x" I] by auto
have good1:"is_interp (adjoint I σ ν)" using adjoint_safe[OF good_interp dfree] by auto
have good2:"is_interp (adjoint I σ ω)" using adjoint_safe[OF good_interp dfree] by auto
have frech:"frechet (local.adjoint I σ ν) θ = frechet (local.adjoint I σ ω) θ"
apply (auto simp add: fun_eq_iff)
subgoal for a b
using sterm_determines_frechet [OF good1 good2 free free sem, of "(a,b)"] by auto
done
then show "dterm_sem (local.adjoint I σ ν) (Differential θ) = dterm_sem (local.adjoint I σ ω) (Differential θ)"
by (auto simp add: directional_derivative_def)
qed (auto)
lemma uadmit_dterm_adjoint:
assumes TUA:"TUadmit σ θ U"
assumes VA:"Vagree ν ω (-U)"
assumes dfree:"⋀f f'. SFunctions σ f = Some f' ⟹ dfree f'"
assumes fsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
assumes dsafe:"dsafe θ"
assumes good_interp:"is_interp I"
shows "dterm_sem (adjoint I σ ν) θ = dterm_sem (adjoint I σ ω) θ"
proof -
have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
by auto
have "⋀x. x ∈ (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ x ∈ (-U)"
using TUA unfolding TUadmit_def by auto
then have sub1:"(⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ -U"
by auto
then have VA':"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
using agree_sub[OF sub1 VA] by auto
then show "?thesis" using uadmit_dterm_adjoint'[OF dfree fsafe good_interp VA' dsafe]
by auto
qed
lemma uadmit_dterm_ntadjoint':
assumes dfree:"⋀i. dsafe (σ i)"
assumes good_interp:"is_interp I"
shows "⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⟹ dsafe θ ⟹ dterm_sem (adjointFO I σ ν) θ = dterm_sem (adjointFO I σ ω) θ"
proof (induct "θ")
case (Plus θ1 θ2 ν ω)
assume IH1:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ dsafe θ1 ⟹ dterm_sem (adjointFO I σ ν) θ1 = dterm_sem (adjointFO I σ ω) θ1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ dsafe θ2 ⟹ dterm_sem (adjointFO I σ ν) θ2 = dterm_sem (adjointFO I σ ω) θ2"
assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (Plus θ1 θ2)}. FVT (σ i))"
then have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
and VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))"
unfolding Vagree_def by auto
assume safe:"dsafe (Plus θ1 θ2)"
show ?case
using IH1[OF VA1] IH2[OF VA2] safe by auto
next
case (Times θ1 θ2 ν ω)
assume IH1:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i)) ⟹ dsafe θ1 ⟹ dterm_sem (adjointFO I σ ν) θ1 = dterm_sem (adjointFO I σ ω) θ1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i)) ⟹ dsafe θ2 ⟹ dterm_sem (adjointFO I σ ν) θ2 = dterm_sem (adjointFO I σ ω) θ2"
assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (Times θ1 θ2)}. FVT (σ i))"
then have VA1:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ1}. FVT (σ i))"
and VA2:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ2}. FVT (σ i))"
unfolding Vagree_def by auto
assume safe:"dsafe (Times θ1 θ2)"
show ?case
using IH1[OF VA1] IH2[OF VA2] safe by auto
next
case (Function x1a x2a)
assume IH:"⋀x. ⋀ν ω. x ∈ range x2a ⟹ Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT x}. FVT (σ i)) ⟹
dsafe x ⟹ dterm_sem (adjointFO I σ ν) x = dterm_sem (adjointFO I σ ω) x"
assume safe:"dsafe (Function x1a x2a)"
from safe have safes:"⋀j. dsafe (x2a j)" by auto
from IH have IH':"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i)) ⟹
dterm_sem (adjointFO I σ ν) (x2a j) = dterm_sem (adjointFO I σ ω) (x2a j)"
using rangeI safes by auto
assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i))"
from VA have VAs:"⋀j. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (x2a j)}. FVT (σ i))"
unfolding Vagree_def SIGT.simps using rangeI by blast
have SIGT:"x1a ∈ SIGT ($f x1a x2a)" by auto
have VAsub:"⋀a. x1a = Inr a⟹ (FVT (σ a)) ⊆ (⋃ i∈{i. Inr i ∈ SIGT ($f x1a x2a)}. FVT (σ i))"
using SIGT by auto
have VAf:"⋀a. x1a = Inr a ⟹ Vagree ν ω (FVT (σ a))"
using agree_sub[OF VAsub VA] by auto
then show ?case
using IH'[OF VAs] apply (auto simp add: fun_eq_iff)
apply(cases "x1a")
defer
subgoal for x1 x2 a
proof -
assume VA:"(⋀a. x1a = Inr a ⟹ Vagree ν ω (FVT (σ a)))"
assume sems:"(⋀j. ∀x1 x2. dterm_sem (adjointFO I σ ν) (x2a j) (x1,x2) = dterm_sem (adjointFO I σ ω) (x2a j) (x1,x2))"
assume some:"x1a = Inr a"
note FVT = VAf[OF some]
have dsafe:"⋀i. dsafe (σ i)"
using dfree dfree_is_dsafe by auto
have dsem:"⋀R . dterm_sem I (σ a) ν = dterm_sem I (σ a) ω"
using coincidence_dterm[OF dsafe FVT] by auto
have "⋀R. Functions (adjointFO I σ ν) x1a R = Functions (adjointFO I σ ω) x1a R"
using dsem some unfolding adjointFO_def by auto
then show "Functions (adjointFO I σ ν) x1a (χ i. dterm_sem (adjointFO I σ ω) (x2a i) (x1,x2)) =
Functions (adjointFO I σ ω) x1a (χ i. dterm_sem (adjointFO I σ ω) (x2a i) (x1,x2))"
by auto
qed
unfolding adjointFO_def apply auto
done
next
case (Differential θ)
assume IH:"⋀ν ω. Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⟹ dsafe θ ⟹ dterm_sem (adjointFO I σ ν) θ = dterm_sem (adjointFO I σ ω) θ"
assume VA:"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT (Differential θ)}. FVT (σ i))"
assume safe:"dsafe (Differential θ)"
then have free:"dfree θ" by (auto dest: dsafe.cases)
from VA have VA':"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))"
by auto
have dsafe:"⋀i. dsafe (σ i)"
using dfree dfree_is_dsafe by auto
have sem:"sterm_sem (adjointFO I σ ν) θ = sterm_sem (adjointFO I σ ω) θ"
using uadmit_sterm_ntadjoint'[OF dsafe VA'] by auto
have good1:"is_interp (adjointFO I σ ν)" using adjointFO_safe[OF good_interp dsafe, of "λi. i"] by auto
have good2:"is_interp (adjointFO I σ ω)" using adjointFO_safe[OF good_interp dsafe, of "λi. i"] by auto
have frech:"frechet (adjointFO I σ ν) θ = frechet (adjointFO I σ ω) θ"
apply (auto simp add: fun_eq_iff)
subgoal for a b
using sterm_determines_frechet [OF good1 good2 free free sem, of "(a,b)"] by auto
done
then show "dterm_sem (adjointFO I σ ν) (Differential θ) = dterm_sem (adjointFO I σ ω) (Differential θ)"
by (auto simp add: directional_derivative_def)
qed (auto)
lemma uadmit_dterm_ntadjoint:
assumes TUA:"NTUadmit σ θ U"
assumes VA:"Vagree ν ω (-U)"
assumes dfree:"⋀i . dsafe (σ i)"
assumes dsafe:"dsafe θ"
assumes good_interp:"is_interp I"
shows "dterm_sem (adjointFO I σ ν) θ = dterm_sem (adjointFO I σ ω) θ"
proof -
have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
by auto
have duh:"⋀A B. A ∩ B = {} ⟹ A ⊆ -B"
by auto
have "⋀x. x ∈ (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⟹ x ∈ (-U)"
using TUA unfolding NTUadmit_def by auto
then have sub1:"(⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i)) ⊆ -U"
by auto
then have VA':"Vagree ν ω (⋃ i∈{i. Inr i ∈ SIGT θ}. FVT (σ i))"
using agree_sub[OF sub1 VA] by auto
then show "?thesis" using uadmit_dterm_ntadjoint'[OF dfree good_interp VA' dsafe]
by auto
qed
definition ssafe ::"('sf, 'sc, 'sz) subst ⇒ bool"
where "ssafe σ ≡
(∀ i f'. SFunctions σ i = Some f' ⟶ dfree f') ∧
(∀ f f'. SPredicates σ f = Some f' ⟶ fsafe f') ∧
(∀ f f'. SPrograms σ f = Some f' ⟶ hpsafe f') ∧
(∀ f f'. SODEs σ f = Some f' ⟶ osafe f') ∧
(∀ C C'. SContexts σ C = Some C' ⟶ fsafe C')"
lemma uadmit_dterm_adjointS:
assumes ssafe:"ssafe σ"
assumes good_interp:"is_interp I"
fixes ν ω
assumes VA:"Vagree ν ω (⋃i∈SIGT θ. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
assumes dsafe:"dsafe θ"
shows "dterm_sem (adjoint I σ ν) θ = dterm_sem (adjoint I σ ω) θ"
proof -
show "?thesis"
apply(rule uadmit_dterm_adjoint')
using good_interp ssafe VA dsafe unfolding ssafe_def by auto
qed
lemma adj_sub_assign_fact:"⋀i j e. i∈SIGT e ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
{Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
{Inl x |x. x ∈ SIGT e}"
unfolding SDom_def apply auto
subgoal for i j
apply (cases "SFunctions σ i")
by auto
done
lemma adj_sub_geq1_fact:"⋀i j x1 x2. i∈SIGT x1 ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
{Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
{Inl x |x. x ∈ SIGT x1 ∨ x ∈ SIGT x2}"
unfolding SDom_def apply auto
subgoal for i j
apply (cases "SFunctions σ i")
by auto
done
lemma adj_sub_geq2_fact:"⋀i j x1 x2. i∈SIGT x2 ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
{Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
{Inl x |x. x ∈ SIGT x1 ∨ x ∈ SIGT x2}"
unfolding SDom_def apply auto
subgoal for i j
apply (cases "SFunctions σ i")
by auto
done
lemma adj_sub_prop_fact:"⋀i j x1 x2 k. i∈SIGT (x2 k) ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
{Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
insert (Inr (Inr x1)) {Inl x |x. ∃xa. x ∈ SIGT (x2 xa)}"
unfolding SDom_def apply auto
subgoal for i j
apply (cases "SFunctions σ i")
by auto
done
lemma adj_sub_ode_fact:"⋀i j x1 x2. Inl i ∈ SIGO x1 ⟹ j ∈ (case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⟹ Inl i ∈({Inl x |x. x ∈ dom (SFunctions σ)} ∪ {Inr (Inl x) |x. x ∈ dom (SContexts σ)} ∪ {Inr (Inr x) |x. x ∈ dom (SPredicates σ)} ∪
{Inr (Inr x) |x. x ∈ dom (SPrograms σ)}) ∩
(SIGF x2 ∪ {Inl x |x. Inl x ∈ SIGO x1} ∪ {Inr (Inr x) |x. Inr x ∈ SIGO x1})"
unfolding SDom_def apply auto
subgoal for i j
apply (cases "SFunctions σ i")
by auto
done
lemma adj_sub_assign:"⋀e σ x. (⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (x := e). SFV σ a)"
subgoal for e σ x
unfolding SDom_def apply auto
subgoal for i j
apply (cases "SFunctions σ j")
apply auto
subgoal for a
using adj_sub_assign_fact[of j e i]
by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
done
done
done
lemma adj_sub_diff_assign:"⋀e σ x. (⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (DiffAssign x e). SFV σ a)"
subgoal for e σ x
unfolding SDom_def apply auto
subgoal for i j
apply (cases "SFunctions σ j")
apply auto
subgoal for a
using adj_sub_assign_fact[of j e i]
by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
done
done
done
lemma adj_sub_geq1:"⋀σ x1 x2. (⋃i∈SIGT x1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
subgoal for σ x1 x2
unfolding SDom_def apply auto
subgoal for x i
apply (cases "SFunctions σ i")
apply auto
subgoal for a
using adj_sub_geq1_fact[of i x1 x σ]
by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
done
done
done
lemma adj_sub_geq2:"⋀σ x1 x2. (⋃i∈SIGT x2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
subgoal for σ x1 x2
unfolding SDom_def apply auto
subgoal for x i
apply (cases "SFunctions σ i")
apply auto
subgoal for a
using adj_sub_geq2_fact[of i x2 x σ]
by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
done
done
done
lemma adj_sub_prop:"⋀σ x1 x2 j . (⋃i∈SIGT (x2 j). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ a)"
subgoal for σ x1 x2 j
unfolding SDom_def apply auto
subgoal for x i
apply (cases "SFunctions σ i")
apply auto
subgoal for a
using adj_sub_prop_fact[of i x2 j x σ x1]
by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
done
done
done
lemma adj_sub_ode:"⋀σ x1 x2. (⋃i∈{i |i. Inl i ∈ SIGO x1}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
subgoal for σ x1 x2
unfolding SDom_def apply auto
subgoal for x i
apply (cases "SFunctions σ i")
apply auto
subgoal for a
using adj_sub_ode_fact[of i x1 x σ x2]
by (metis (mono_tags, lifting) SFV.simps(1) option.simps(5))
done
done
done
lemma uadmit_ode_adjoint':
fixes σ I
assumes ssafe:"ssafe σ"
assumes good_interp:"is_interp I"
shows"⋀ν ω. Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x)⟹ osafe ODE ⟹ ODE_sem (adjoint I σ ν) ODE = ODE_sem (adjoint I σ ω) ODE"
proof (induction ODE)
case (OVar x)
then show ?case unfolding adjoint_def by auto
next
case (OSing x1a x2)
assume VA:"Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO (OSing x1a x2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
assume osafe:"osafe (OSing x1a x2)"
then have dfree:"dfree x2" by (auto dest: osafe.cases)
have safes:"(⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f')"
"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
using ssafe unfolding ssafe_def using dfree_is_dsafe by auto
have sem:"sterm_sem (local.adjoint I σ ν) x2 = sterm_sem (local.adjoint I σ ω) x2"
using uadmit_sterm_adjoint'[of σ ν ω x2 I, OF safes, of "(λ x y. x)" "(λ x y. x)"] VA
by auto
show ?case
apply auto
apply (rule ext)
subgoal for x
apply (rule vec_extensionality)
using sem by auto
done
next
case (OProd ODE1 ODE2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO ODE1}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⟹
osafe ODE1 ⟹ ODE_sem (local.adjoint I σ ν) ODE1 = ODE_sem (local.adjoint I σ ω) ODE1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO ODE2}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⟹
osafe ODE2 ⟹ ODE_sem (local.adjoint I σ ν) ODE2 = ODE_sem (local.adjoint I σ ω) ODE2"
assume VA:"Vagree ν ω (⋃i∈{i |i. Inl i ∈ SIGO (OProd ODE1 ODE2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
assume safe:"osafe (OProd ODE1 ODE2)"
from safe have safe1:"osafe ODE1" and safe2:"osafe ODE2" by (auto dest: osafe.cases)
have sub1:"(⋃i∈{i |i. Inl i ∈ SIGO ODE1}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⊆ (⋃i∈{i |i. Inl i ∈ SIGO (OProd ODE1 ODE2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
by auto
have sub2:"(⋃i∈{i |i. Inl i ∈ SIGO ODE2}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a) ⊆ (⋃i∈{i |i. Inl i ∈ SIGO (OProd ODE1 ODE2)}. case SFunctions σ i of None ⇒ {} | Some a ⇒ FVT a)"
by auto
then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
qed
lemma uadmit_ode_ntadjoint':
fixes σ I
assumes ssafe:"⋀i. dsafe (σ i)"
assumes good_interp:"is_interp I"
shows"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y)) ⟹ osafe ODE ⟹ ODE_sem (adjointFO I σ ν) ODE = ODE_sem (adjointFO I σ ω) ODE"
proof (induction ODE)
case (OVar x)
then show ?case unfolding adjointFO_def by auto
next
case (OSing x1a x2)
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO (OSing x1a x2)}. FVT (σ y))"
assume osafe:"osafe (OSing x1a x2)"
then have dfree:"dfree x2" by (auto dest: osafe.cases)
have sem:"sterm_sem (adjointFO I σ ν) x2 = sterm_sem (adjointFO I σ ω) x2"
using uadmit_sterm_ntadjoint'[of σ ν ω x2 I, OF ssafe] VA
by auto
show ?case
apply auto
apply (rule ext)
subgoal for x
apply (rule vec_extensionality)
using sem by auto
done
next
case (OProd ODE1 ODE2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE1}. FVT (σ y)) ⟹
osafe ODE1 ⟹ ODE_sem (adjointFO I σ ν) ODE1 = ODE_sem (adjointFO I σ ω) ODE1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE2}. FVT (σ y)) ⟹
osafe ODE2 ⟹ ODE_sem (adjointFO I σ ν) ODE2 = ODE_sem (adjointFO I σ ω) ODE2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO (OProd ODE1 ODE2)}. FVT (σ y))"
assume safe:"osafe (OProd ODE1 ODE2)"
from safe have safe1:"osafe ODE1" and safe2:"osafe ODE2" by (auto dest: osafe.cases)
have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGO (OProd ODE1 ODE2)}. FVT (σ y))"
by auto
have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGO (OProd ODE1 ODE2)}. FVT (σ y))"
by auto
then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
qed
lemma adjoint_ode_vars:
shows "ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
apply(induction ODE)
unfolding adjoint_def by auto
lemma uadmit_mkv_adjoint:
assumes ssafe:"ssafe σ"
assumes good_interp:"is_interp I"
assumes VA:"Vagree ν ω (⋃i ∈ {i | i. (Inl i∈SIGO ODE)}. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {})"
assumes osafe:"osafe ODE"
shows "mk_v (adjoint I σ ν) ODE = mk_v (adjoint I σ ω) ODE"
apply(rule ext)
subgoal for R
apply(rule ext)
subgoal for solt
apply(rule agree_UNIV_eq)
using mk_v_agree[of "(adjoint I σ ν)" ODE "R" solt]
using mk_v_agree[of "(adjoint I σ ω)" ODE "R" solt]
using uadmit_ode_adjoint'[OF ssafe good_interp VA osafe]
unfolding Vagree_def
apply auto
subgoal for i
apply (cases "Inl i ∈ Inl ` ODE_vars (adjoint I σ ω) ODE")
proof -
assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
apply(induction ODE)
unfolding adjoint_def by auto
assume thing1:"
∀i. (Inl i ∈ Inl ` ODE_vars (local.adjoint I σ ν) ODE ⟶ fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = solt $ i) ∧
(Inl i ∈ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶ fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = solt $ i)"
assume thing2:"
∀i. (Inl i ∈ Inl ` ODE_vars (local.adjoint I σ ω) ODE ⟶ fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = solt $ i) ∧
(Inl i ∈ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶ fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = solt $ i)"
assume inl:"Inl i ∈ Inl ` ODE_vars (local.adjoint I σ ω) ODE"
from thing1 and inl have eq1: "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = solt $ i"
using vars_eq by auto
from thing2 and inl have eq2: "fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = solt $ i"
using vars_eq by auto
show "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
using eq1 eq2 by auto
next
assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
assume thing1:"∀i. Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ν) ODE ∧ Inl i ∉ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶
fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst R $ i"
assume thing2:"∀i. Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ω) ODE ∧ Inl i ∉ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶
fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = fst R $ i"
assume inl:"Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ω) ODE"
have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
apply(induction ODE)
unfolding adjoint_def by auto
from thing1 and inl have eq1: "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst R $ i"
using vars_eq by auto
from thing2 and inl have eq2: "fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i = fst R $ i"
using vars_eq by auto
show "fst (mk_v (local.adjoint I σ ν) ODE R solt) $ i = fst (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
using eq1 eq2 by auto
qed
subgoal for i
apply (cases "Inr i ∈ Inr ` ODE_vars (adjoint I σ ω) ODE")
proof -
assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
assume thing1:"∀i. (Inr i ∈ Inl ` ODE_vars (local.adjoint I σ ν) ODE ⟶
snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i) ∧
(Inr i ∈ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶
snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i)"
assume thing2:"∀i. (Inr i ∈ Inl ` ODE_vars (local.adjoint I σ ω) ODE ⟶
snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i) ∧
(Inr i ∈ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶
snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = ODE_sem (local.adjoint I σ ω) ODE solt $ i)"
assume inr:"Inr i ∈ Inr ` ODE_vars (local.adjoint I σ ω) ODE"
have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
apply(induction ODE)
unfolding adjoint_def by auto
show "snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
using thing1 thing2 vars_eq inr by auto
next
assume sem_eq:"ODE_sem (local.adjoint I σ ν) ODE = ODE_sem (local.adjoint I σ ω) ODE"
assume thing1:"∀i. Inr i ∉ Inl ` ODE_vars (local.adjoint I σ ν) ODE ∧ Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ν) ODE ⟶
snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd R $ i"
assume thing2:"∀i. Inr i ∉ Inl ` ODE_vars (local.adjoint I σ ω) ODE ∧ Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ω) ODE ⟶
snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = snd R $ i"
assume inr:"Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ω) ODE"
have vars_eq:"ODE_vars (local.adjoint I σ ν) ODE = ODE_vars (local.adjoint I σ ω) ODE"
apply(induction ODE)
unfolding adjoint_def by auto
have eq1:"snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd R $ i"
using thing1 sem_eq vars_eq inr by auto
have eq2:"snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i = snd R $ i"
using thing2 sem_eq vars_eq inr by auto
show "snd (mk_v (local.adjoint I σ ν) ODE R solt) $ i = snd (mk_v (local.adjoint I σ ω) ODE R solt) $ i"
using eq1 eq2 by auto
qed
done
done
done
lemma adjointFO_ode_vars:
shows "ODE_vars (adjointFO I σ ν) ODE = ODE_vars (adjointFO I σ ω) ODE"
apply(induction ODE)
unfolding adjointFO_def by auto
lemma uadmit_mkv_ntadjoint:
assumes ssafe:"⋀i. dsafe (σ i)"
assumes good_interp:"is_interp I"
assumes VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y))"
assumes osafe:"osafe ODE"
shows "mk_v (adjointFO I σ ν) ODE = mk_v (adjointFO I σ ω) ODE"
apply(rule ext)
subgoal for R
apply(rule ext)
subgoal for solt
apply(rule agree_UNIV_eq)
using mk_v_agree[of "(adjointFO I σ ν)" ODE "R" solt]
using mk_v_agree[of "(adjointFO I σ ω)" ODE "R" solt]
using uadmit_ode_ntadjoint'[OF ssafe good_interp VA osafe]
unfolding Vagree_def
apply auto
using adjointFO_ode_vars by metis+
done
done
lemma uadmit_prog_fml_adjoint':
fixes σ I
assumes ssafe:"ssafe σ"
assumes good_interp:"is_interp I"
shows "⋀ν ω. Vagree ν ω (⋃x∈SDom σ ∩ SIGP α. SFV σ x) ⟹ hpsafe α ⟹ prog_sem (adjoint I σ ν) α = prog_sem (adjoint I σ ω) α"
and "⋀ν ω. Vagree ν ω (⋃x∈SDom σ ∩ SIGF φ. SFV σ x) ⟹ fsafe φ ⟹ fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
proof (induct "α" and "φ")
case (Pvar x)
then show ?case unfolding adjoint_def by auto
next
case (Assign x e)
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x := e). SFV σ a)"
assume safe:"hpsafe (x := e)"
from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
have sub:"(⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (x := e). SFV σ a)"
using adj_sub_assign[of σ e x] by auto
have "dterm_sem (local.adjoint I σ ν) e = dterm_sem (local.adjoint I σ ω) e"
by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub VA] dsafe])
then show ?case by (auto simp add: vec_eq_iff)
next
case (DiffAssign x e)
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (DiffAssign x e). SFV σ a)"
assume safe:"hpsafe (DiffAssign x e)"
from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
have sub:"(⋃i∈SIGT e. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGP (DiffAssign x e). SFV σ a)"
using adj_sub_diff_assign[of σ e] by auto
have "dterm_sem (local.adjoint I σ ν) e = dterm_sem (local.adjoint I σ ω) e"
by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub VA] dsafe])
then show ?case by (auto simp add: vec_eq_iff)
next
case (Test x)
assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⟹ fsafe x ⟹ fml_sem (adjoint I σ ν) x = fml_sem (adjoint I σ ω) x"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (? x). SFV σ a)"
assume hpsafe:"hpsafe (? x)"
then have fsafe:"fsafe x" by (auto dest: hpsafe.cases)
have sub:"(⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (? x). SFV σ a)"
by auto
have "fml_sem (adjoint I σ ν) x = fml_sem (adjoint I σ ω) x"
using IH[OF agree_sub[OF sub VA] fsafe] by auto
then show ?case by auto
next
case (EvolveODE x1 x2)
assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
assume safe:"hpsafe (EvolveODE x1 x2)"
then have osafe:"osafe x1" and fsafe:"fsafe x2" by (auto dest: hpsafe.cases)
have sub1:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
by auto
then have VAF:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a)"
using agree_sub[OF sub1 VA] by auto
note IH' = IH[OF VAF fsafe]
have sub:"(⋃i∈{i |i. Inl i ∈ SIGO x1}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (⋃a∈SDom σ ∩ SIGP (EvolveODE x1 x2). SFV σ a)"
using adj_sub_ode[of σ x1 x2] by auto
moreover have IH2:"ODE_sem (local.adjoint I σ ν) x1 = ODE_sem (local.adjoint I σ ω) x1"
apply (rule uadmit_ode_adjoint')
subgoal by (rule ssafe)
subgoal by (rule good_interp)
subgoal using agree_sub[OF sub VA] by auto
subgoal by (rule osafe)
done
have mkv:"mk_v (adjoint I σ ν) x1 = mk_v (adjoint I σ ω) x1"
apply (rule uadmit_mkv_adjoint)
using ssafe good_interp osafe agree_sub[OF sub VA] by auto
show ?case
apply auto
subgoal for aa ba bb sol t
apply(rule exI[where x = sol])
apply(rule conjI)
subgoal by auto
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkv by auto
apply(rule conjI)
subgoal by auto using IH2 mkv IH' by auto
subgoal for aa ba bb sol t
apply(rule exI[where x = sol])
apply(rule conjI)
subgoal by auto
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkv by auto
apply(rule conjI)
subgoal by auto using IH2 mkv IH' by auto
done
next
case (Choice x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⟹ hpsafe x1 ⟹ prog_sem (local.adjoint I σ ν) x1 = prog_sem (local.adjoint I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⟹ hpsafe x2 ⟹ prog_sem (local.adjoint I σ ν) x2 = prog_sem (local.adjoint I σ ω) x2"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x1 ∪∪ x2). SFV σ a)"
assume safe:"hpsafe (x1 ∪∪ x2)"
from safe have
safe1:"hpsafe x1"
and safe2:"hpsafe x2"
by (auto dest: hpsafe.cases)
have sub1:"(⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ∪∪ x2). SFV σ a)"
by auto
have sub2:"(⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ∪∪ x2). SFV σ a)"
by auto
then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (Sequence x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⟹ hpsafe x1 ⟹ prog_sem (local.adjoint I σ ν) x1 = prog_sem (local.adjoint I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⟹ hpsafe x2 ⟹ prog_sem (local.adjoint I σ ν) x2 = prog_sem (local.adjoint I σ ω) x2"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x1 ;; x2). SFV σ a)"
assume safe:"hpsafe (x1 ;; x2)"
from safe have
safe1:"hpsafe x1"
and safe2:"hpsafe x2"
by (auto dest: hpsafe.cases)
have sub1:"(⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ;; x2). SFV σ a)"
by auto
have sub2:"(⋃a∈SDom σ ∩ SIGP x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x1 ;; x2). SFV σ a)"
by auto
then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (Loop x)
assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x. SFV σ a) ⟹ hpsafe x ⟹ prog_sem (local.adjoint I σ ν) x = prog_sem (local.adjoint I σ ω) x"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGP (x**). SFV σ a)"
assume safe:"hpsafe (x**)"
from safe have
safe:"hpsafe x"
by (auto dest: hpsafe.cases)
have sub:"(⋃a∈SDom σ ∩ SIGP x. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGP (x**). SFV σ a)"
by auto
show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
case (Geq x1 x2)
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
assume safe:"fsafe (Geq x1 x2)"
then have dsafe1:"dsafe x1" and dsafe2:"dsafe x2" by (auto dest: fsafe.cases)
have sub1:"(⋃i∈SIGT x1. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
using adj_sub_geq1[of σ x1 x2] by auto
have sub2:"(⋃i∈SIGT x2. case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF (Geq x1 x2). SFV σ a)"
using adj_sub_geq2[of σ x2 x1] by auto
have "dterm_sem (local.adjoint I σ ν) x1 = dterm_sem (local.adjoint I σ ω) x1"
by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub1 VA] dsafe1])
moreover have "dterm_sem (local.adjoint I σ ν) x2 = dterm_sem (local.adjoint I σ ω) x2"
by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF sub2 VA] dsafe2])
ultimately show ?case by auto
next
case (Prop x1 x2 ν ω)
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ a)"
assume safe:"fsafe ($φ x1 x2)"
then have safes:"⋀i. dsafe (x2 i)" using dfree_is_dsafe by auto
have subs:"⋀j. (⋃i∈SIGT (x2 j). case SFunctions σ i of Some x ⇒ FVT x | None ⇒ {}) ⊆ (⋃a∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ a)"
subgoal for j using adj_sub_prop[of σ x2 j x1] by auto
done
have "⋀i. dterm_sem (local.adjoint I σ ν) (x2 i) = dterm_sem (local.adjoint I σ ω) (x2 i)"
by (rule uadmit_dterm_adjointS[OF ssafe good_interp agree_sub[OF subs VA] safes])
then have vec_eq:"⋀R. (χ i. dterm_sem (local.adjoint I σ ν) (x2 i) R) = (χ i. dterm_sem (local.adjoint I σ ω) (x2 i) R)"
by (auto simp add: vec_eq_iff)
from VA have VAs:"⋀j. Vagree ν ω (⋃i∈SIGT (x2 j). case SFunctions σ i of Some a ⇒ FVT a | None ⇒ {})"
unfolding Vagree_def SIGT.simps using rangeI
by (metis (no_types, lifting) subsetD subs)
have SIGF:"⋀a. SPredicates σ x1 = Some a ⟹ Inr (Inr x1) ∈ SDom σ ∩ SIGF ($φ x1 x2)" unfolding SDom_def
by auto
have VAsub:"⋀a. SPredicates σ x1 = Some a ⟹ (FVF a) ⊆ (⋃i∈SDom σ ∩ SIGF ($φ x1 x2). SFV σ i)"
using SIGF by auto
have VAf:"⋀a. SPredicates σ x1 = Some a ⟹ Vagree ν ω (FVF a)"
using agree_sub[OF VAsub VA] by auto
then show ?case
apply(cases "SPredicates σ x1")
defer
subgoal for a
proof -
assume some:"SPredicates σ x1 = Some a"
note FVF = VAf[OF some]
have dsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
using ssafe dfree_is_dsafe unfolding ssafe_def by auto
have dsem:"⋀R . (ν ∈ fml_sem (extendf I R) a) = (ω ∈ fml_sem (extendf I R) a)"
subgoal for R
apply (rule coincidence_formula)
subgoal using ssafe unfolding ssafe_def using some by auto
subgoal unfolding Iagree_def by auto
subgoal by (rule FVF)
done
done
have pred_eq:"⋀R. Predicates (local.adjoint I σ ν) x1 R = Predicates (local.adjoint I σ ω) x1 R"
using dsem some unfolding adjoint_def by auto
show "fml_sem (local.adjoint I σ ν) ($φ x1 x2) = fml_sem (local.adjoint I σ ω) ($φ x1 x2)"
apply auto
subgoal for a b using pred_eq[of "(χ i. dterm_sem (local.adjoint I σ ν) (x2 i) (a, b))"] vec_eq by auto
subgoal for a b using pred_eq[of "(χ i. dterm_sem (local.adjoint I σ ν) (x2 i) (a, b))"] vec_eq by auto
done
qed
unfolding adjoint_def using local.adjoint_def local.vec_eq apply auto
done
next
case (Not x)
assume IH:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⟹ fsafe x ⟹ fml_sem (local.adjoint I σ ν) x = fml_sem (local.adjoint I σ ω) x"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Not x). SFV σ a)"
assume safe:"fsafe (Not x)"
from safe have
safe:"fsafe x"
by (auto dest: fsafe.cases)
have sub:"(⋃a∈SDom σ ∩ SIGF x. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Not x). SFV σ a)"
by auto
show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
case (And x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x1. SFV σ a) ⟹ fsafe x1 ⟹ fml_sem (local.adjoint I σ ν) x1 = fml_sem (local.adjoint I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (And x1 x2). SFV σ a)"
assume safe:"fsafe (And x1 x2)"
from safe have
safe1:"fsafe x1"
and safe2:"fsafe x2"
by (auto dest: fsafe.cases)
have sub1:"(⋃a∈SDom σ ∩ SIGF x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (And x1 x2). SFV σ a)"
by auto
have sub2:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (And x1 x2). SFV σ a)"
by auto
show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (Exists x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Exists x1 x2). SFV σ a)"
assume safe:"fsafe (Exists x1 x2)"
from safe have safe1:"fsafe x2"
by (auto dest: fsafe.cases)
have sub1:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Exists x1 x2). SFV σ a)"
by auto
show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] by auto
next
case (Diamond x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⟹ hpsafe x1 ⟹ prog_sem (local.adjoint I σ ν) x1 = prog_sem (local.adjoint I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (Diamond x1 x2). SFV σ a)"
assume safe:"fsafe (Diamond x1 x2)"
from safe have
safe1:"hpsafe x1"
and safe2:"fsafe x2"
by (auto dest: fsafe.cases)
have sub1:"(⋃a∈SDom σ ∩ SIGP x1. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Diamond x1 x2). SFV σ a)"
by auto
have sub2:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (Diamond x1 x2). SFV σ a)"
by auto
show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (InContext x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⟹ fsafe x2 ⟹ fml_sem (local.adjoint I σ ν) x2 = fml_sem (local.adjoint I σ ω) x2"
assume VA:"Vagree ν ω (⋃a∈SDom σ ∩ SIGF (InContext x1 x2). SFV σ a)"
assume safe:"fsafe (InContext x1 x2)"
from safe have safe1:"fsafe x2"
by (auto dest: fsafe.cases)
have sub:"(⋃a∈SDom σ ∩ SIGF x2. SFV σ a) ⊆ (⋃a∈SDom σ ∩ SIGF (InContext x1 x2). SFV σ a)"
by auto
show ?case using IH1[OF agree_sub[OF sub VA] safe1]
unfolding adjoint_def by auto
qed
lemma uadmit_prog_adjoint:
assumes PUA:"PUadmit σ a U"
assumes VA:"Vagree ν ω (-U)"
assumes hpsafe:"hpsafe a"
assumes ssafe:"ssafe σ"
assumes good_interp:"is_interp I"
shows "prog_sem (adjoint I σ ν) a = prog_sem (adjoint I σ ω) a"
proof -
have sub:"(⋃x∈SDom σ ∩ SIGP a. SFV σ x) ⊆ -U" using PUA unfolding PUadmit_def by auto
have VA':"Vagree ν ω (⋃x∈SDom σ ∩ SIGP a. SFV σ x)" using agree_sub[OF sub VA] by auto
show ?thesis
apply(rule uadmit_prog_fml_adjoint'[OF ssafe good_interp])
subgoal by (rule VA')
subgoal by (rule hpsafe)
done
qed
lemma uadmit_fml_adjoint:
assumes FUA:"FUadmit σ φ U"
assumes VA:"Vagree ν ω (-U)"
assumes fsafe:"fsafe φ"
assumes ssafe:"ssafe σ"
assumes good_interp:"is_interp I"
shows "fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
proof -
have sub:"(⋃x∈SDom σ ∩ SIGF φ. SFV σ x) ⊆ -U" using FUA unfolding FUadmit_def by auto
have VA':"Vagree ν ω (⋃x∈SDom σ ∩ SIGF φ. SFV σ x)" using agree_sub[OF sub VA] by auto
show ?thesis
apply(rule uadmit_prog_fml_adjoint'[OF ssafe good_interp])
subgoal by (rule VA')
subgoal by (rule fsafe)
done
qed
lemma ntadj_sub_assign:"⋀e σ x. (⋃y∈{y. Inr y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (Assign x e)}. FVT (σ y))"
by auto
lemma ntadj_sub_diff_assign:"⋀e σ x. (⋃y∈{y. Inl y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGP (DiffAssign x e)}. FVT (σ y))"
by auto
lemma ntadj_sub_geq1:"⋀σ x1 x2. (⋃y∈{y. Inl y ∈ SIGT x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
by auto
lemma ntadj_sub_geq2:"⋀σ x1 x2. (⋃y∈{y. Inl y ∈ SIGT x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
by auto
lemma ntadj_sub_prop:"⋀σ x1 x2 j. (⋃y∈{y. Inl y ∈ SIGT (x2 j)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGF ($φ x1 x2)}.FVT (σ y))"
by auto
lemma ntadj_sub_ode:"⋀σ x1 x2. (⋃y∈{y. Inl (Inl y) ∈ SIGO x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inl y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
by auto
lemma uadmit_prog_fml_ntadjoint':
fixes σ I
assumes ssafe:"⋀i. dsafe (σ i)"
assumes good_interp:"is_interp I"
shows "⋀ν ω. Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGP α}. FVT (σ x)) ⟹ hpsafe α ⟹ prog_sem (adjointFO I σ ν) α = prog_sem (adjointFO I σ ω) α"
and "⋀ν ω. Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGF φ}. FVT (σ x)) ⟹ fsafe φ ⟹ fml_sem (adjointFO I σ ν) φ = fml_sem (adjointFO I σ ω) φ"
proof (induct "α" and "φ")
case (Pvar x)
then show ?case unfolding adjointFO_def by auto
next
case (Assign x e)
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (Assign x e)}. FVT (σ y))"
assume safe:"hpsafe (x := e)"
from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
have sub:"(⋃y∈{y. Inr y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (Assign x e)}. FVT (σ y))"
using ntadj_sub_assign[of σ e x] by auto
have VA':"(Vagree ν ω (⋃i∈{i. Inr i ∈ SIGT e}. FVT (σ i)))"
using agree_sub[OF sub VA] by auto
have "dterm_sem (adjointFO I σ ν) e = dterm_sem (adjointFO I σ ω) e"
using uadmit_dterm_ntadjoint'[of σ I ν ω e] ssafe good_interp agree_sub[OF sub VA] dsafe by auto
then show ?case by (auto simp add: vec_eq_iff)
next
case (DiffAssign x e)
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (DiffAssign x e)}. FVT (σ y))"
assume safe:"hpsafe (DiffAssign x e)"
from safe have dsafe:"dsafe e" by (auto dest: hpsafe.cases)
have sub:"(⋃y∈{y. Inr y ∈ SIGT e}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (DiffAssign x e)}. FVT (σ y))"
using ntadj_sub_assign[of σ e x] by auto
have VA':"(Vagree ν ω (⋃i∈{i. Inr i ∈ SIGT e}. FVT (σ i)))"
using agree_sub[OF sub VA] by auto
have "dterm_sem (adjointFO I σ ν) e = dterm_sem (adjointFO I σ ω) e"
using uadmit_dterm_ntadjoint'[of σ I ν ω e] ssafe good_interp agree_sub[OF sub VA] dsafe by auto
then show ?case by (auto simp add: vec_eq_iff)
next
case (Test x)
assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⟹ fsafe x ⟹ fml_sem (adjointFO I σ ν) x = fml_sem (adjointFO I σ ω) x"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (? x)}. FVT (σ y))"
assume hpsafe:"hpsafe (? x)"
then have fsafe:"fsafe x" by (auto dest: hpsafe.cases)
have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (? x)}. FVT (σ y))"
by auto
have "fml_sem (adjointFO I σ ν) x = fml_sem (adjointFO I σ ω) x"
using IH[OF agree_sub[OF sub VA] fsafe] by auto
then show ?case by auto
next
case (EvolveODE x1 x2)
assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
assume safe:"hpsafe (EvolveODE x1 x2)"
then have osafe:"osafe x1" and fsafe:"fsafe x2" by (auto dest: hpsafe.cases)
have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
by auto
then have VAF:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y))"
using agree_sub[OF sub1 VA] by auto
note IH' = IH[OF VAF fsafe]
have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGO x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (EvolveODE x1 x2)}. FVT (σ y))"
by auto
moreover have IH2:"ODE_sem (adjointFO I σ ν) x1 = ODE_sem (adjointFO I σ ω) x1"
apply (rule uadmit_ode_ntadjoint')
subgoal by (rule ssafe)
subgoal by (rule good_interp)
defer subgoal by (rule osafe)
using agree_sub[OF sub VA] by auto
have mkv:"mk_v (adjointFO I σ ν) x1 = mk_v (adjointFO I σ ω) x1"
apply (rule uadmit_mkv_ntadjoint)
using ssafe good_interp osafe agree_sub[OF sub VA] by auto
show ?case
apply auto
subgoal for aa ba bb sol t
apply(rule exI[where x = sol])
apply(rule conjI)
subgoal by auto
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkv by auto
apply(rule conjI)
subgoal by auto using IH2 mkv IH' by auto
subgoal for aa ba bb sol t
apply(rule exI[where x = sol])
apply(rule conjI)
subgoal by auto
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkv by auto
apply(rule conjI)
subgoal by auto using IH2 mkv IH' by auto
done
next
case (Choice x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⟹ hpsafe x1 ⟹ prog_sem (adjointFO I σ ν) x1 = prog_sem (adjointFO I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x2}. FVT (σ y)) ⟹ hpsafe x2 ⟹ prog_sem (adjointFO I σ ν) x2 = prog_sem (adjointFO I σ ω) x2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ∪∪ x2)}. FVT (σ y))"
assume safe:"hpsafe (x1 ∪∪ x2)"
from safe have
safe1:"hpsafe x1"
and safe2:"hpsafe x2"
by (auto dest: hpsafe.cases)
have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGP (x1)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ∪∪ x2)}. FVT (σ y))"
by auto
have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGP (x2)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ∪∪ x2)}. FVT (σ y))"
by auto
then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (Sequence x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⟹ hpsafe x1 ⟹ prog_sem (adjointFO I σ ν) x1 = prog_sem (adjointFO I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x2}. FVT (σ y)) ⟹ hpsafe x2 ⟹ prog_sem (adjointFO I σ ν) x2 = prog_sem (adjointFO I σ ω) x2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ;; x2)}. FVT (σ y))"
assume safe:"hpsafe (x1 ;; x2)"
from safe have
safe1:"hpsafe x1"
and safe2:"hpsafe x2"
by (auto dest: hpsafe.cases)
have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ;; x2)}. FVT (σ y))"
by auto
have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGP x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x1 ;; x2)}. FVT (σ y))"
by auto
then show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (Loop x)
assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x}. FVT (σ y)) ⟹ hpsafe x ⟹ prog_sem (adjointFO I σ ν) x = prog_sem (adjointFO I σ ω) x"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP (x** )}. FVT (σ y))"
assume safe:"hpsafe (x** )"
from safe have
safe:"hpsafe x"
by (auto dest: hpsafe.cases)
have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGP (x )}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGP (x** )}. FVT (σ y))"
by auto
show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
case (Geq x1 x2)
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
assume safe:"fsafe (Geq x1 x2)"
then have dsafe1:"dsafe x1" and dsafe2:"dsafe x2" by (auto dest: fsafe.cases)
have sub1:"(⋃y∈{y. Inr y ∈ SIGT x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
by auto
have sub2:"(⋃y∈{y. Inr y ∈ SIGT x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Geq x1 x2)}. FVT (σ y))"
by auto
have "dterm_sem (adjointFO I σ ν) x1 = dterm_sem (adjointFO I σ ω) x1"
by (rule uadmit_dterm_ntadjoint'[OF ssafe good_interp agree_sub[OF sub1 VA] dsafe1])
moreover have "dterm_sem (adjointFO I σ ν) x2 = dterm_sem (adjointFO I σ ω) x2"
by (rule uadmit_dterm_ntadjoint'[OF ssafe good_interp agree_sub[OF sub2 VA] dsafe2])
ultimately show ?case by auto
next
case (Prop x1 x2 ν ω)
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF ($φ x1 x2)}. FVT (σ y))"
assume safe:"fsafe ($φ x1 x2)"
then have safes:"⋀i. dsafe (x2 i)" using dfree_is_dsafe by auto
have subs:"⋀j. (⋃y∈{y. Inr y ∈ SIGT (x2 j)}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF ($φ x1 x2)}. FVT (σ y))"
subgoal for j by auto
done
have "⋀i. dterm_sem (adjointFO I σ ν) (x2 i) = dterm_sem (adjointFO I σ ω) (x2 i)"
by (rule uadmit_dterm_ntadjoint'[OF ssafe good_interp agree_sub[OF subs VA] safes])
then have vec_eq:"⋀R. (χ i. dterm_sem (adjointFO I σ ν) (x2 i) R) = (χ i. dterm_sem (adjointFO I σ ω) (x2 i) R)"
by (auto simp add: vec_eq_iff)
from VA have VAs:"⋀j. Vagree ν ω (⋃y∈{y. Inr y ∈ SIGT (x2 j)}. FVT (σ y))"
subgoal for j
using agree_sub[OF subs[of j] VA] by auto
done
then show ?case
using vec_eq by (auto simp add: adjointFO_def)
next
case (Not x)
assume IH:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⟹ fsafe x ⟹ fml_sem (adjointFO I σ ν) x = fml_sem (adjointFO I σ ω) x"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Not x)}. FVT (σ y))"
assume safe:"fsafe (Not x)"
from safe have
safe:"fsafe x"
by (auto dest: fsafe.cases)
have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Not x)}. FVT (σ y))"
by auto
show ?case using IH[OF agree_sub[OF sub VA] safe] by auto
next
case (And x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x1}. FVT (σ y)) ⟹ fsafe x1 ⟹ fml_sem (adjointFO I σ ν) x1 = fml_sem (adjointFO I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (And x1 x2)}. FVT (σ y))"
assume safe:"fsafe (And x1 x2)"
from safe have
safe1:"fsafe x1"
and safe2:"fsafe x2"
by (auto dest: fsafe.cases)
have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (And x1 x2)}. FVT (σ y))"
by auto
have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (And x1 x2)}. FVT (σ y))"
by auto
show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (Exists x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Exists x1 x2)}. FVT (σ y))"
assume safe:"fsafe (Exists x1 x2)"
from safe have safe1:"fsafe x2"
by (auto dest: fsafe.cases)
have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Exists x1 x2)}. FVT (σ y))"
by auto
show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] by auto
next
case (Diamond x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⟹ hpsafe x1 ⟹ prog_sem (adjointFO I σ ν) x1 = prog_sem (adjointFO I σ ω) x1"
assume IH2:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (Diamond x1 x2)}. FVT (σ y))"
assume safe:"fsafe (Diamond x1 x2)"
from safe have
safe1:"hpsafe x1"
and safe2:"fsafe x2"
by (auto dest: fsafe.cases)
have sub1:"(⋃y∈{y. Inl (Inr y) ∈ SIGP x1}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Diamond x1 x2)}. FVT (σ y))"
by auto
have sub2:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (Diamond x1 x2)}. FVT (σ y))"
by auto
show ?case using IH1[OF agree_sub[OF sub1 VA] safe1] IH2[OF agree_sub[OF sub2 VA] safe2] by auto
next
case (InContext x1 x2)
assume IH1:"⋀ν ω. Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⟹ fsafe x2 ⟹ fml_sem (adjointFO I σ ν) x2 = fml_sem (adjointFO I σ ω) x2"
assume VA:"Vagree ν ω (⋃y∈{y. Inl (Inr y) ∈ SIGF (InContext x1 x2)}. FVT (σ y))"
assume safe:"fsafe (InContext x1 x2)"
from safe have safe1:"fsafe x2"
by (auto dest: fsafe.cases)
have sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGF x2}. FVT (σ y)) ⊆ (⋃y∈{y. Inl (Inr y) ∈ SIGF (InContext x1 x2)}. FVT (σ y))"
by auto
show ?case using IH1[OF agree_sub[OF sub VA] safe1]
unfolding adjointFO_def by auto
qed
lemma uadmit_prog_ntadjoint:
assumes TUA:"PUadmitFO σ α U"
assumes VA:"Vagree ν ω (-U)"
assumes dfree:"⋀i . dsafe (σ i)"
assumes hpsafe:"hpsafe α"
assumes good_interp:"is_interp I"
shows "prog_sem (adjointFO I σ ν) α = prog_sem (adjointFO I σ ω) α"
proof -
have sub:"(⋃x∈{x. Inl (Inr x) ∈ SIGP α}. FVT (σ x)) ⊆ -U" using TUA unfolding PUadmitFO_def by auto
have VA':"Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGP α}. FVT (σ x))" using agree_sub[OF sub VA] by auto
show ?thesis
apply(rule uadmit_prog_fml_ntadjoint'[OF dfree good_interp])
subgoal by (rule VA')
subgoal by (rule hpsafe)
done
qed
lemma uadmit_fml_ntadjoint:
assumes TUA:"FUadmitFO σ φ U"
assumes VA:"Vagree ν ω (-U)"
assumes dfree:"⋀i . dsafe (σ i)"
assumes fsafe:"fsafe φ"
assumes good_interp:"is_interp I"
shows "fml_sem (adjointFO I σ ν) φ = fml_sem (adjointFO I σ ω) φ"
proof -
have sub:"(⋃x∈{x. Inl (Inr x) ∈ SIGF φ}. FVT (σ x)) ⊆ -U" using TUA unfolding FUadmitFO_def by auto
have VA':"Vagree ν ω (⋃x∈{x. Inl (Inr x) ∈ SIGF φ}. FVT (σ x))" using agree_sub[OF sub VA] by auto
show ?thesis
apply(rule uadmit_prog_fml_ntadjoint'[OF dfree good_interp])
subgoal by (rule VA')
subgoal by (rule fsafe)
done
qed
subsection‹Substitution theorems for terms›
lemma nsubst_sterm:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
shows "TadmitFFO σ θ ⟹ (⋀i. dsafe (σ i)) ⟹ sterm_sem I (TsubstFO θ σ) (fst ν) = sterm_sem (adjointFO I σ ν) θ (fst ν)"
proof (induction rule: TadmitFFO.induct)
case (TadmitFFO_Fun1 σ args f)
then show ?case by(auto simp add: adjointFO_def)
next
case (TadmitFFO_Fun2 σ args f)
then show ?case
apply(auto simp add: adjointFO_def)
by (simp add: dsem_to_ssem)
qed (auto)
lemma nsubst_sterm':
fixes I::"('sf, 'sc, 'sz) interp"
fixes a b::"'sz simple_state"
shows "TadmitFFO σ θ ⟹ (⋀i. dsafe (σ i)) ⟹ sterm_sem I (TsubstFO θ σ) a = sterm_sem (adjointFO I σ (a,b)) θ a"
using nsubst_sterm by (metis fst_conv)
lemma ntsubst_preserves_free:
"dfree θ ⟹ (⋀i. dfree (σ i)) ⟹ dfree(TsubstFO θ σ)"
proof (induction rule: dfree.induct)
case (dfree_Fun args i) then show "?case"
by (cases "i") (auto intro:dfree.intros)
qed (auto intro: dfree.intros)
lemma tsubst_preserves_free:
"dfree θ ⟹ (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ dfree(Tsubst θ σ)"
proof (induction rule: dfree.induct)
case (dfree_Fun args i) then show "?case"
by (cases "SFunctions σ i") (auto intro:dfree.intros ntsubst_preserves_free)
qed (auto intro: dfree.intros)
lemma subst_sterm:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
shows "
TadmitF σ θ ⟹
(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹
sterm_sem I (Tsubst θ σ) (fst ν) = sterm_sem (adjoint I σ ν) θ (fst ν)"
proof (induction rule: TadmitF.induct)
case (TadmitF_Fun1 σ args f f') then
have subFree:" TadmitFFO (λi. Tsubst (args i) σ) f'"
and frees:"⋀i. dfree (Tsubst (args i) σ)"
and TFA:"⋀i. TadmitF σ (args i)"
and NTFA:"TadmitFFO (λi. Tsubst (args i) σ) f'"
and theIH:"⋀i. sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (local.adjoint I σ ν) (args i) (fst ν)"
by auto
from frees have safes:"⋀i. dsafe (Tsubst (args i) σ)"
by (simp add: dfree_is_dsafe)
assume subFreeer:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
note admit = TadmitF_Fun1.hyps(1) and sfree = TadmitF_Fun1.prems(1)
have IH:"(⋀i. sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (adjoint I σ ν) (args i) (fst ν))"
using admit TadmitF_Fun1.prems TadmitF_Fun1.IH by auto
have vec_eq:"(χ i. sterm_sem (local.adjoint I σ ν) (args i) (fst ν)) = (χ i. sterm_sem I (Tsubst (args i) σ) (fst ν))"
apply(rule vec_extensionality)
using IH by auto
assume some:"SFunctions σ f = Some f'"
let ?sub = "(λ i. Tsubst (args i) σ)"
have IH2:"sterm_sem I (TsubstFO f' ?sub) (fst ν) = sterm_sem (adjointFO I ?sub ν) f' (fst ν)"
apply(rule nsubst_sterm)
apply(rule subFree)
by (rule safes)
show "?case"
apply (simp add: some)
unfolding vec_eq IH2
by (auto simp add: some adjoint_free[OF subFreeer, of σ "(λ x y. x)" I ν] adjointFO_free[OF frees])
next
case (TadmitF_Fun2 σ args f)
assume none:"SFunctions σ f = None"
note admit = TadmitF_Fun2.hyps(1) and sfree = TadmitF_Fun2.prems(1)
have IH:"(⋀i. TadmitF σ (args i) ⟹
sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (adjoint I σ ν) (args i) (fst ν))"
using TadmitF_Fun2.prems TadmitF_Fun2.IH by auto
have eqs:"⋀i. sterm_sem I (Tsubst (args i) σ) (fst ν) = sterm_sem (adjoint I σ ν) (args i) (fst ν)"
by (auto simp add: IH admit)
show "?case"
by(auto simp add: none IH adjoint_def vec_extensionality eqs)
qed auto
lemma nsubst_dterm':
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
assumes good_interp:"is_interp I"
shows "TadmitFO σ θ ⟹ dfree θ ⟹ (⋀i. dsafe (σ i)) ⟹ dterm_sem I (TsubstFO θ σ) ν = dterm_sem (adjointFO I σ ν) θ ν"
proof (induction rule: TadmitFO.induct)
case (TadmitFO_Fun σ args f)
assume admit:"⋀i. TadmitFO σ (args i)"
assume IH:"⋀i. dfree (args i) ⟹ (⋀i. dsafe (σ i)) ⟹ dterm_sem I (TsubstFO (args i) σ) ν = dterm_sem (adjointFO I σ ν) (args i) ν"
assume free:"dfree ($f f args)"
assume safe:"⋀i. dsafe (σ i)"
from free have frees: "⋀i. dfree (args i)" by (auto dest: dfree.cases)
have sem:"⋀i. dterm_sem I (TsubstFO (args i) σ) ν = dterm_sem (adjointFO I σ ν) (args i) ν"
using IH[OF frees safe] by auto
have vecEq:" (χ i. dterm_sem (adjointFO I σ ν) (args i) ν) =
(χ i. dterm_sem
⦇Functions = case_sum (Functions I) (λf' _. dterm_sem I (σ f') ν), Predicates = Predicates I, Contexts = Contexts I,
Programs = Programs I, ODEs = ODEs I, ODEBV = ODEBV I⦈
(args i) ν) "
apply(rule vec_extensionality)
by (auto simp add: adjointFO_def)
show " dterm_sem I (TsubstFO ($f f args) σ) ν = dterm_sem (adjointFO I σ ν) ($f f args) ν"
apply (cases "f")
apply (auto simp add: vec_extensionality adjointFO_def)
using sem apply auto
subgoal for a using vecEq by auto
done
next
case (TadmitFO_Diff σ θ)
hence admit:"TadmitFFO σ θ"
and admitU:"NTUadmit σ θ UNIV"
and safe: "dfree (Differential θ)"
and freeSub:"⋀i. dsafe (σ i)"
by auto
from safe have "False" by (auto dest: dfree.cases)
then show "dterm_sem I (TsubstFO (Differential θ) σ) ν = dterm_sem (adjointFO I σ ν) (Differential θ) ν"
by auto
qed (auto simp add: TadmitFO.cases)
lemma ntsubst_free_to_safe:
"dfree θ ⟹ (⋀i. dsafe (σ i)) ⟹ dsafe (TsubstFO θ σ)"
proof (induction rule: dfree.induct)
case (dfree_Fun args i) then show "?case"
by (cases "i") (auto intro:dsafe.intros ntsubst_preserves_free)
qed (auto intro: dsafe.intros)
lemma ntsubst_preserves_safe:
"dsafe θ ⟹ (⋀i. dfree (σ i)) ⟹ dsafe (TsubstFO θ σ)"
proof (induction rule: dsafe.induct)
case (dsafe_Fun args i) then show "?case"
by (cases "i") (auto intro:dsafe.intros ntsubst_preserves_free dfree_is_dsafe)
next
case (dsafe_Diff θ) then show "?case"
by (auto intro:dsafe.intros ntsubst_preserves_free)
qed (auto simp add: ntsubst_preserves_free intro: dsafe.intros)
lemma tsubst_preserves_safe:
"dsafe θ ⟹ (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ dsafe(Tsubst θ σ)"
proof (induction rule: dsafe.induct)
case (dsafe_Fun args i)
assume dsafes:"⋀i. dsafe (args i)"
assume IH:"⋀j. (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ dsafe (Tsubst (args j) σ)"
assume frees:"⋀i f. SFunctions σ i = Some f ⟹ dfree f"
have IH':"⋀i. dsafe (Tsubst (args i) σ)"
using frees IH by auto
then show "?case"
apply auto
apply(cases "SFunctions σ i")
subgoal using IH frees by auto
subgoal for a using frees[of i a] ntsubst_free_to_safe[of a] IH' by auto
done
qed (auto intro: dsafe.intros tsubst_preserves_free)
lemma subst_dterm:
fixes I::"('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"
shows "
Tadmit σ θ ⟹
dsafe θ ⟹
(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹
(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f') ⟹
(⋀ν. dterm_sem I (Tsubst θ σ) ν = dterm_sem (adjoint I σ ν) θ ν)"
proof (induction rule: Tadmit.induct)
case (Tadmit_Fun1 σ args f f' ν)
note safe = Tadmit_Fun1.prems(1) and sfree = Tadmit_Fun1.prems(2) and TA = Tadmit_Fun1.hyps(1)
and some = Tadmit_Fun1.hyps(2) and NTA = Tadmit_Fun1.hyps(3)
hence safes:"⋀i. dsafe (args i)" by auto
have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)"
using Tadmit_Fun1.prems Tadmit_Fun1.IH by auto
have eqs:"⋀i ν'. dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν"
by (auto simp add: IH safes)
let ?sub = "(λ i. Tsubst (args i) σ)"
have subSafe:"(⋀i. dsafe (?sub i))"
using tsubst_preserves_safe[OF safes sfree]
by (simp add: safes sfree tsubst_preserves_safe)
have freef:"dfree f'" using sfree some by auto
have IH2:"dterm_sem I (TsubstFO f' ?sub) ν = dterm_sem (adjointFO I ?sub ν) f' ν"
by (simp add: nsubst_dterm'[OF good_interp NTA freef subSafe])
have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (local.adjoint I σ ν) (args i) ν)"
apply(auto simp add: vec_eq_iff)
subgoal for i
using IH[of i, OF safes[of i]]
by auto
done
show "?case"
using IH safes eqs apply (auto simp add: IH2 some good_interp)
using some unfolding adjoint_def adjointFO_def by auto
next
case (Tadmit_Fun2 σ args f ν)
note safe = Tadmit_Fun2.prems(1) and sfree = Tadmit_Fun2.prems(2) and TA = Tadmit_Fun2.hyps(1)
and none = Tadmit_Fun2.hyps(2)
hence safes:"⋀i. dsafe (args i)" by auto
have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)"
using Tadmit_Fun2.prems Tadmit_Fun2.IH by auto
have Ieq:"Functions I f = Functions (adjoint I σ ν) f"
using none unfolding adjoint_def by auto
have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (adjoint I σ ν) (args i) ν)"
apply(auto simp add: vec_eq_iff)
subgoal for i using IH[of i, OF safes[of i]] by auto
done
show "?case" using none IH Ieq vec by auto
next
case (Tadmit_Diff σ θ) then
have TA:"Tadmit σ θ"
and TUA:"TUadmit σ θ UNIV"
and IH:"dsafe θ ⟹ (⋀i f'. SFunctions σ i = Some f' ⟹ dfree f') ⟹ (⋀ν. dterm_sem I (Tsubst θ σ) ν = dterm_sem (local.adjoint I σ ν) θ ν)"
and safe:"dsafe (Differential θ)"
and sfree:"⋀i f'1. SFunctions σ i = Some f'1 ⟹ dfree f'1"
and spsafe:"⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f'"
by auto
from sfree have sdsafe:"⋀f f'. SFunctions σ f = Some f' ⟹ dsafe f'"
using dfree_is_dsafe by auto
have VA:"⋀ν ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
from safe have free:"dfree θ" by (auto dest: dsafe.cases intro: dfree.intros)
from free have tsafe:"dsafe θ" using dfree_is_dsafe by auto
have freeSubst:"dfree (Tsubst θ σ)"
using tsubst_preserves_free[OF free sfree]
using Tadmit_Diff.prems(2) free tsubst_preserves_free by blast
have IH':"⋀ν. dterm_sem I (Tsubst θ σ) ν = dterm_sem (local.adjoint I σ ν) θ ν"
using IH[OF tsafe sfree] by auto
have sem_eq:"⋀ν'. dsafe θ ⟹ is_interp I ⟹ dterm_sem (local.adjoint I σ ν) θ = dterm_sem (local.adjoint I σ ν') θ"
subgoal for ν'
using uadmit_dterm_adjoint[OF TUA VA sfree spsafe, of "(λ x y. x)" "(λ x y. x)" I ν ν']
by auto
done
have IH'':"⋀ν'. dterm_sem I (Tsubst θ σ) ν' = dterm_sem (local.adjoint I σ ν) θ ν'"
subgoal for ν'
using sem_eq[OF tsafe good_interp, of ν'] IH'[of ν'] by auto
done
have sem_eq:"sterm_sem I (Tsubst θ σ) = sterm_sem (local.adjoint I σ ν) θ"
apply (auto simp add: fun_eq_iff)
subgoal for ν'
apply (cases "ν'")
subgoal for ν''
apply auto
using dsem_to_ssem[OF free, of "(local.adjoint I σ ν)" "(ν',ν')"] dsem_to_ssem[OF freeSubst, of I "(ν',ν')"] IH'[of "(ν)"]
apply auto
using IH'' by auto
done
done
show "?case"
apply (auto simp add: directional_derivative_def fun_eq_iff)
using sterm_determines_frechet[OF
good_interp
adjoint_safe[OF good_interp sfree]
tsubst_preserves_free[OF free sfree]
free sem_eq]
by auto
qed auto
subsection‹Substitution theorems for ODEs›
lemma osubst_preserves_safe:
assumes ssafe:"ssafe σ"
shows "(osafe ODE ⟹ Oadmit σ ODE U ⟹ osafe (Osubst ODE σ))"
proof (induction rule: osafe.induct)
case (osafe_Var c)
then show ?case using ssafe unfolding ssafe_def by (cases "SODEs σ c", auto intro: osafe.intros)
next
case (osafe_Sing θ x)
then show ?case
using tsubst_preserves_free ssafe unfolding ssafe_def by (auto intro: osafe.intros)
next
case (osafe_Prod ODE1 ODE2)
moreover have "Oadmit σ ODE1 U" "Oadmit σ ODE2 U" "ODE_dom (Osubst ODE1 σ) ∩ ODE_dom (Osubst ODE2 σ) = {}"
using osafe_Prod.prems by (auto dest: Oadmit.cases)
ultimately show ?case by (auto intro: osafe.intros)
qed
lemma nosubst_preserves_safe:
assumes sfree:"⋀i. dfree (σ i)"
fixes α ::"('a + 'd, 'b, 'c) hp" and φ ::"('a + 'd, 'b, 'c) formula"
shows "(osafe ODE ⟹ OUadmitFO σ ODE U ⟹ osafe (OsubstFO ODE σ))"
proof (induction rule: osafe.induct)
case (osafe_Var c)
then show ?case by (auto intro: osafe.intros)
next
case (osafe_Sing θ x)
then show ?case using sfree ntsubst_preserves_free[of θ σ] unfolding OUadmitFO_def by (auto intro: osafe.intros)
next
case (osafe_Prod ODE1 ODE2)
assume safe1:"osafe ODE1"
and safe2:"osafe ODE2"
and disj:"ODE_dom ODE1 ∩ ODE_dom ODE2 = {}"
and IH1:"OUadmitFO σ ODE1 U ⟹ osafe (OsubstFO ODE1 σ)"
and IH2:"OUadmitFO σ ODE2 U ⟹ osafe (OsubstFO ODE2 σ)"
and NOUA:"OUadmitFO σ (OProd ODE1 ODE2) U"
have nosubst_preserves_ODE_dom:"⋀ODE. ODE_dom (OsubstFO ODE σ) = ODE_dom ODE"
subgoal for ODE
apply(induction "ODE")
by auto
done
have disj':"ODE_dom (OsubstFO ODE1 σ) ∩ ODE_dom (OsubstFO ODE2 σ) = {}"
using disj nosubst_preserves_ODE_dom by auto
from NOUA have NOUA1:"OUadmitFO σ ODE1 U" and NOUA2:"OUadmitFO σ ODE2 U" unfolding OUadmitFO_def by auto
then show ?case using IH1[OF NOUA1] IH2[OF NOUA2] disj' by (auto intro: osafe.intros)
qed
lemma nsubst_dterm:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
fixes ν'::"'sz state"
assumes good_interp:"is_interp I"
shows "TadmitFO σ θ ⟹ dsafe θ ⟹ (⋀i. dsafe (σ i)) ⟹ dterm_sem I (TsubstFO θ σ) ν = dterm_sem (adjointFO I σ ν) θ ν"
proof (induction rule: TadmitFO.induct)
case (TadmitFO_Diff σ θ) then
have subFree:"(⋀i. dsafe (σ i))"
and NTFA:"TadmitFFO σ θ"
and substFree:"dfree (TsubstFO θ σ)"
and dsafe:"dsafe (Differential θ)"
and subSafe:"⋀i. dsafe (σ i)"
and NTU:"NTUadmit σ θ UNIV"
by auto
have dfree:"dfree θ" using dsafe by auto
then show ?case
apply auto
apply (unfold directional_derivative_def)
apply (rule sterm_determines_frechet)
subgoal using good_interp by auto
subgoal using adjointFO_safe[OF good_interp, of σ] subSafe by auto
subgoal using substFree by auto
subgoal using dfree by auto
subgoal
apply(rule ext)
subgoal for x
using nsubst_sterm'[of σ θ I "(fst ν)" "(snd ν)", OF NTFA subSafe] apply auto
proof -
assume sem:"sterm_sem I (TsubstFO θ σ) (fst ν) = sterm_sem (adjointFO I σ ν) θ (fst ν)"
have VA:"⋀ν ω. Vagree ν (x,snd ν) (-UNIV)" unfolding Vagree_def by auto
show "sterm_sem I (TsubstFO θ σ) x = sterm_sem (adjointFO I σ ν) θ x"
using uadmit_sterm_ntadjoint[OF NTU VA subSafe, OF good_interp, of "(x, snd ν)"]
nsubst_sterm[OF NTFA subSafe, of I ν ]
apply auto
using NTU VA dfree_is_dsafe dsafe subSafe substFree good_interp uadmit_sterm_ntadjoint
by (metis NTFA fst_eqD nsubst_sterm)
qed
done
done
next
case (TadmitFO_Fun σ args f)
then show ?case apply auto apply(cases f) unfolding adjointFO_def by auto
qed (auto)
lemma nsubst_ode:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
fixes ν'::"'sz state"
assumes good_interp:"is_interp I"
shows "osafe ODE ⟹ OadmitFO σ ODE U ⟹ (⋀i. dsafe (σ i)) ⟹ ODE_sem I (OsubstFO ODE σ) (fst ν)= ODE_sem (adjointFO I σ ν) ODE (fst ν)"
proof (induction rule: osafe.induct)
case (osafe_Var c)
then show ?case unfolding OUadmitFO_def adjointFO_def by auto
next
case (osafe_Sing θ x)
then show ?case apply auto
using nsubst_sterm' [of σ θ I "(fst ν)" "(snd ν)"] by auto
next
case (osafe_Prod ODE1 ODE2) then
have NO1:"OadmitFO σ ODE1 U" and NO2:"OadmitFO σ ODE2 U"
unfolding OUadmitFO_def by auto
have "ODE_sem I (OsubstFO ODE1 σ) (fst ν) = ODE_sem (adjointFO I σ ν) ODE1 (fst ν)"
"ODE_sem I (OsubstFO ODE2 σ) (fst ν) = ODE_sem (adjointFO I σ ν) ODE2 (fst ν)" using osafe_Prod.IH osafe_Prod.prems osafe_Prod.hyps
using NO1 NO2 by auto
then show ?case by auto
qed
lemma osubst_preserves_BVO:
shows "BVO (OsubstFO ODE σ) = BVO ODE"
proof (induction "ODE")
qed (auto)
lemma osubst_preserves_ODE_vars:
shows "ODE_vars I (OsubstFO ODE σ) = ODE_vars (adjointFO I σ ν) ODE"
proof (induction "ODE")
qed (auto simp add: adjointFO_def)
lemma osubst_preserves_semBV:
shows "semBV I (OsubstFO ODE σ) = semBV (adjointFO I σ ν) ODE"
proof (induction "ODE")
qed (auto simp add: adjointFO_def)
lemma nsubst_mkv:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
fixes ν'::"'sz state"
assumes good_interp:"is_interp I"
assumes NOU:"OadmitFO σ ODE U"
assumes osafe:"osafe ODE "
assumes frees:"(⋀i. dsafe (σ i))"
shows "(mk_v I (OsubstFO ODE σ) ν (fst ν'))
= (mk_v (adjointFO I σ ν') ODE ν (fst ν'))"
apply(rule agree_UNIV_eq)
using mk_v_agree[of "adjointFO I σ ν'" "ODE" ν "fst ν'"]
using mk_v_agree[of "I" "OsubstFO ODE σ" ν "fst ν'"]
unfolding Vagree_def
using nsubst_ode[OF good_interp osafe NOU frees, of ν']
apply auto
subgoal for i
apply(erule allE[where x=i])+
apply(cases "Inl i ∈ semBV I (OsubstFO ODE σ)")
using osubst_preserves_ODE_vars
by (metis (full_types))+
subgoal for i
apply(erule allE[where x=i])+
apply(cases "Inr i ∈ BVO ODE")
using osubst_preserves_ODE_vars
by (metis (full_types))+
done
lemma ODE_unbound_zero:
fixes i
shows "Inl i ∉ BVO ODE ⟹ ODE_sem I ODE x $ i = 0"
proof (induction ODE)
qed (auto)
lemma ODE_bound_effect:
fixes s t sol ODE X b
assumes s:"s ∈ {0..t}"
assumes sol:"(sol solves_ode (λ_. ODE_sem I ODE)) {0..t} X"
shows "Vagree (sol 0,b) (sol s, b) (-(BVO ODE))"
proof -
have "⋀i. Inl i ∉ BVO ODE ⟹ (∀ s. s ∈ {0..t} ⟶ sol s $ i = sol 0 $ i)"
apply auto
apply (rule constant_when_zero)
using s sol apply auto
using ODE_unbound_zero solves_ode_subset
by fastforce+
then show "Vagree (sol 0, b) (sol s, b) (- BVO ODE)"
unfolding Vagree_def
using s by (metis Compl_iff fst_conv snd_conv)
qed
lemma NO_sub:"OadmitFO σ ODE A ⟹ B ⊆ A ⟹ OadmitFO σ ODE B"
by(induction ODE, auto simp add: OUadmitFO_def)
lemma NO_to_NOU:"OadmitFO σ ODE S ⟹ OUadmitFO σ ODE S"
by(induction ODE, auto simp add: OUadmitFO_def)
subsection‹Substitution theorems for formulas and programs›
lemma nsubst_hp_fml:
fixes I::"('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"
shows " (NPadmit σ α ⟶ (hpsafe α ⟶ (∀i. dsafe (σ i)) ⟶ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO α σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) α)))) ∧
(NFadmit σ φ ⟶ (fsafe φ ⟶ (∀i. dsafe (σ i)) ⟶ (∀ ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))))"
proof (induction rule: NPadmit_NFadmit.induct)
case (NPadmit_Pvar σ a)
then show ?case unfolding adjointFO_def by auto
next
case (NPadmit_ODE σ ODE φ) then
have NOU:"OadmitFO σ ODE (BVO ODE)"
and NFA:"NFadmit σ φ"
and NFU:"FUadmitFO σ φ (BVO ODE)"
and fsafe:"fsafe (FsubstFO φ σ)"
and IH:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
and osafe':"osafe (OsubstFO ODE σ)"
by auto
have "hpsafe (EvolveODE ODE φ) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (EvolveODE ODE φ)))"
proof -
assume safe:"hpsafe (EvolveODE ODE φ)"
then have osafe:"osafe ODE" and fsafe:"fsafe φ" by auto
assume frees:"(⋀i. dsafe (σ i))"
fix ν ω
show "((ν, ω) ∈ prog_sem I (PsubstFO (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (EvolveODE ODE φ))"
proof (auto)
fix b
and sol :: "real ⇒(real, 'sz) vec"
and t :: real
assume eq1:"ν = (sol 0, b)"
assume eq2:"ω = mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..t}
{x. mk_v I (OsubstFO ODE σ) (sol 0, b) x ∈ fml_sem I (FsubstFO φ σ)}"
have agree_sem:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ)))"
subgoal for t
using mk_v_agree[of I "OsubstFO ODE σ" "(sol 0, b)" "sol t"] unfolding Vagree_def apply auto
done
done
have bv_sub:"(-BVO ODE) ⊆ - (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ))"
by(induction ODE, auto)
have agree:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- BVO ODE)"
using agree_sub[OF bv_sub agree_sem] by auto
have mkv:"⋀t. mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t) = mk_v (adjointFO I σ (sol t, b)) ODE (sol 0, b) (sol t)"
using nsubst_mkv[OF good_interp NOU osafe frees]
by auto
have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (-(BVO ODE))"
using ODE_bound_effect sol
by (metis osubst_preserves_BVO)
have FVT_sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y)) ⊆ (-(BVO ODE))"
using NOU NO_to_NOU OUadmitFO_def
by fastforce
have agrees:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y))"
subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
have "⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE = mk_v (adjointFO I σ (sol 0, b)) ODE"
subgoal for s
apply (rule uadmit_mkv_ntadjoint)
prefer 3
using NOU hmm[of s] NO_to_NOU unfolding OUadmitFO_def Vagree_def
apply fastforce
using frees good_interp osafe by auto
done
then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s)"
by presburger
have main_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s) "
using mkv mkva by auto
note mkvt = main_eq[of t]
have fml_eq1:"⋀s. s ∈ {0..t} ⟹
(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ))
= (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)"
using IH[OF fsafe frees] by auto
have fml_eq2:"⋀s. s ∈ {0..t} ⟹
((mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)
=(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ))"
subgoal for s
using NFU frees fsafe good_interp mk_v_agree osubst_preserves_ODE_vars uadmit_fml_ntadjoint
using agree by blast
done
have fml_eq3:"⋀s. s ∈ {0..t} ⟹
(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) = (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) "
using main_eq by auto
have fml_eq: "⋀s. s ∈ {0..t} ⟹
(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ))
= (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)"
using fml_eq1 fml_eq2 fml_eq3 by meson
have sem_eq:"⋀t. ODE_sem I (OsubstFO ODE σ) (sol t) = ODE_sem (adjointFO I σ (sol t, b)) ODE (sol t)"
subgoal for t
using nsubst_ode[OF good_interp osafe NOU frees, of "(sol t,b)"] by auto
done
have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (OsubstFO ODE σ) (sol s) = ODE_sem (adjointFO I σ (sol 0, b)) ODE (sol s)"
subgoal for s
using nsubst_ode[OF good_interp osafe NOU frees, of "(sol s, b)"]
uadmit_ode_ntadjoint'[OF frees good_interp agrees[of s] osafe]
by auto
done
have sol':"(sol solves_ode (λ_. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..t}
{x. mk_v I (OsubstFO ODE σ) (sol 0, b) x ∈ fml_sem I (FsubstFO φ σ)}"
apply (rule solves_ode_congI)
apply (rule sol)
subgoal for ta by auto
subgoal for ta by (rule sem_fact[of ta])
subgoal by (rule refl)
subgoal by (rule refl)
done
have sub:"⋀s. s ∈ {0..t}
⟹ sol s ∈ {x. (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)}"
using fml_eq rangeI t sol solves_ode_domainD by fastforce
have sol'':"(sol solves_ode (λc. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..t}
{x. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ}"
apply (rule solves_odeI)
subgoal using sol' solves_ode_vderivD by blast
using sub by auto
show "∃sola. sol 0 = sola 0 ∧
(∃ta. mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t) = mk_v (adjointFO I σ (sol 0, b)) ODE (sola 0, b) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..ta}
{x. mk_v (adjointFO I σ (sol 0, b)) ODE (sola 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ})"
apply(rule exI[where x=sol])
apply(rule conjI)
subgoal by (rule refl)
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkvt t by auto
apply(rule conjI)
subgoal by (rule t)
subgoal by (rule sol'')
done
next
fix b
and sol::"real ⇒ (real, 'sz) vec"
and t::real
assume eq1:"ν = (sol 0, b)"
assume eq2:"ω = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol t)"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa. ODE_sem (adjointFO I σ (sol 0, b)) ODE)) {0..t}
{x. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ}"
have agree_sem:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ)))"
subgoal for t
using mk_v_agree[of I "OsubstFO ODE σ" "(sol 0, b)" "sol t"] unfolding Vagree_def apply auto
done
done
have bv_sub:"(-BVO ODE) ⊆ - (Inl ` ODE_vars I (OsubstFO ODE σ) ∪ Inr ` ODE_vars I (OsubstFO ODE σ))"
by(induction ODE, auto)
have agree:"⋀t. Vagree (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t)) (sol 0, b) (- BVO ODE)"
using agree_sub[OF bv_sub agree_sem] by auto
have mkv:"⋀t. mk_v I (OsubstFO ODE σ) (sol 0, b) (sol t) = mk_v (adjointFO I σ (sol t, b)) ODE (sol 0, b) (sol t)"
using nsubst_mkv[OF good_interp NOU osafe frees]
by auto
have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (-(BVO ODE))"
using ODE_bound_effect sol
by (metis osubst_preserves_ODE_vars)
have FVT_sub:"(⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y)) ⊆ (-(BVO ODE))"
using NOU NO_to_NOU unfolding OUadmitFO_def by fastforce
have agrees:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,b) (sol s, b) (⋃y∈{y. Inl (Inr y) ∈ SIGO ODE}. FVT (σ y))"
subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
have "⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE = mk_v (adjointFO I σ (sol 0, b)) ODE"
subgoal for s
apply (rule uadmit_mkv_ntadjoint)
prefer 3
using NOU hmm[of s] NO_to_NOU unfolding OUadmitFO_def Vagree_def
apply fastforce
using frees good_interp osafe by auto
done
then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjointFO I σ (sol s, b)) ODE (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s)"
by presburger
have main_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) = mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol s) "
using mkv mkva by auto
note mkvt = main_eq[of t]
have fml_eq1:"⋀s. s ∈ {0..t} ⟹
(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ))
= (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)"
using IH[OF fsafe frees] by auto
have fml_eq2:"⋀s. s ∈ {0..t} ⟹
((mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s))) φ)
=(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ))"
using NFU frees fsafe good_interp mk_v_agree osubst_preserves_ODE_vars uadmit_fml_ntadjoint agree by blast
have fml_eq3:"⋀s. s ∈ {0..t} ⟹
(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) = (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ) "
using main_eq by auto
have fml_eq: "⋀s. s ∈ {0..t} ⟹
(mk_v I (OsubstFO ODE σ) (sol 0, b) (sol s) ∈ fml_sem I (FsubstFO φ σ))
= (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) (sol s) ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)"
using fml_eq1 fml_eq2 fml_eq3 by meson
have sem_eq:"⋀t. ODE_sem I (OsubstFO ODE σ) (sol t) = ODE_sem (adjointFO I σ (sol t, b)) ODE (sol t)"
subgoal for t
using nsubst_ode[OF good_interp osafe NOU frees, of "(sol t,b)"] by auto
done
have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (OsubstFO ODE σ) (sol s) = ODE_sem (adjointFO I σ (sol 0, b)) ODE (sol s)"
subgoal for s
using nsubst_ode[OF good_interp osafe NOU frees, of "(sol s, b)"]
uadmit_ode_ntadjoint'[OF frees good_interp agrees[of s] osafe]
by auto
done
have sol':"
(sol solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..t} {x. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ}"
apply (rule solves_ode_congI)
apply (rule sol)
subgoal for ta by auto
subgoal for ta using sem_fact[of ta] by auto
subgoal by (rule refl)
subgoal by (rule refl)
done
have sub:"⋀s. s ∈ {0..t}
⟹ sol s ∈ {x. (mk_v (adjointFO I σ (sol 0,b)) ODE (sol 0, b) x ∈ fml_sem (adjointFO I σ (sol 0, b)) φ)}"
using fml_eq rangeI t sol solves_ode_domainD by fastforce
have sol'':"(sol solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..t} {x. mk_v I (OsubstFO ODE σ) (sol 0, b) x ∈ fml_sem I (FsubstFO φ σ)}"
apply (rule solves_odeI)
subgoal using sol' solves_ode_vderivD by blast
using sub fml_eq by blast
show "∃sola. sol 0 = sola 0 ∧
(∃ta. mk_v (adjointFO I σ (sol 0, b)) ODE (sol 0, b) (sol t) = mk_v I (OsubstFO ODE σ) (sola 0, b) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODE_sem I (OsubstFO ODE σ))) {0..ta} {x. mk_v I (OsubstFO ODE σ) (sola 0, b) x ∈ fml_sem I (FsubstFO φ σ)})"
apply(rule exI[where x=sol])
apply(rule conjI)
subgoal by (rule refl)
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using t mkvt by auto
apply(rule conjI)
subgoal by (rule t)
subgoal by (rule sol'')
done
qed
qed
then show ?case by auto
next
case (NPadmit_Assign σ θ x)
then show ?case using nsubst_dterm[OF good_interp, of σ θ] by auto
next
case (NPadmit_DiffAssign σ θ x)
then show ?case using nsubst_dterm[OF good_interp, of σ θ] by auto
next
case (NFadmit_Geq σ θ1 θ2)
then show ?case
using nsubst_dterm[OF good_interp, of σ θ1]
using nsubst_dterm[OF good_interp, of σ θ2] by auto
next
case (NFadmit_Prop σ args f)
assume NTA:"⋀i. TadmitFO σ (args i)"
have "⋀ν. fsafe ($φ f args) ⟹ (⋀i. dsafe (σ i)) ⟹ (ν ∈ fml_sem I (FsubstFO ($φ f args) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) ($φ f args))"
proof -
fix ν
assume safe:"fsafe ($φ f args)"
from safe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
assume subFree:"(⋀i. dsafe (σ i))"
have vec_eq:"(χ i. dterm_sem (adjointFO I σ ν) (args i) ν) = (χ i. dterm_sem I (TsubstFO (args i) σ) ν)"
apply(rule vec_extensionality)
using nsubst_dterm[OF good_interp NTA safes subFree] by auto
then show "?thesis ν" unfolding adjointFO_def by auto
qed
then show ?case by auto
next
case (NPadmit_Sequence σ a b) then
have PUA:"PUadmitFO σ b (BVP (PsubstFO a σ))"
and PA:"NPadmit σ a"
and IH1:"hpsafe a ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a))"
and IH2:"hpsafe b ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO b σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) b))"
and hpsafeS:"hpsafe (PsubstFO a σ)"
by auto
have "hpsafe (a ;; b) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a ;; b)))"
proof -
assume hpsafe:"hpsafe (a ;; b)"
assume ssafe:"(⋀i. dsafe (σ i))"
from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by (auto dest: hpsafe.cases)
fix ν ω
have agree:"⋀μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹ Vagree ν μ (-BVP(PsubstFO a σ))"
subgoal for μ
using bound_effect[OF good_interp, of "(PsubstFO a σ)" ν , OF hpsafeS] by auto
done
have sem_eq:"⋀μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹
((μ, ω) ∈ prog_sem (adjointFO I σ ν) b) =
((μ, ω) ∈ prog_sem (adjointFO I σ μ) b)"
subgoal for μ
proof -
assume assm:"(ν, μ) ∈ prog_sem I (PsubstFO a σ)"
show "((μ, ω) ∈ prog_sem (adjointFO I σ ν) b) = ((μ, ω) ∈ prog_sem (adjointFO I σ μ) b)"
using uadmit_prog_ntadjoint [OF PUA agree[OF assm] ssafe safe2 good_interp]
by auto
qed
done
have "((ν, ω) ∈ prog_sem I (PsubstFO (a ;; b) σ)) = (∃ μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ∧ (μ, ω) ∈ prog_sem I (PsubstFO b σ))"
by auto
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ∧ (μ, ω) ∈ prog_sem (adjointFO I σ μ) b)"
using IH2[OF safe2 ssafe] by auto
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ∧ (μ, ω) ∈ prog_sem (adjointFO I σ ν) b)"
using sem_eq by auto
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem (adjointFO I σ ν) a ∧ (μ, ω) ∈ prog_sem (adjointFO I σ ν) b)"
using IH1[OF safe1 ssafe] by auto
ultimately
show "((ν, ω) ∈ prog_sem I (PsubstFO (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a ;; b))"
by auto
qed
then show ?case by auto
next
case (NPadmit_Loop σ a) then
have PA:"NPadmit σ a"
and PUA:"PUadmitFO σ a (BVP (PsubstFO a σ))"
and IH:"hpsafe a ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a))"
and hpsafeS:"hpsafe (PsubstFO a σ)"
by auto
have "hpsafe (a**) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO (a**) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a**)))"
proof -
assume "hpsafe (a**)"
then have hpsafe:"hpsafe a" by (auto dest: hpsafe.cases)
assume ssafe:"(⋀i. dsafe (σ i))"
have agree:"⋀ν μ. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹ Vagree ν μ (-BVP(PsubstFO a σ))"
subgoal for ν μ
using bound_effect[OF good_interp, of "(PsubstFO a σ)" ν, OF hpsafeS]
by auto
done
have sem_eq:"⋀ν μ ω. (ν, μ) ∈ prog_sem I (PsubstFO a σ) ⟹
((μ, ω) ∈ prog_sem (adjointFO I σ ν) a) =
((μ, ω) ∈ prog_sem (adjointFO I σ μ) a)"
subgoal for ν μ ω
proof -
assume assm:"(ν, μ) ∈ prog_sem I (PsubstFO a σ)"
show "((μ, ω) ∈ prog_sem (adjointFO I σ ν) a) = ((μ, ω) ∈ prog_sem (adjointFO I σ μ) a)"
using uadmit_prog_ntadjoint[OF PUA agree[OF assm] ssafe hpsafe good_interp] by auto
qed
done
fix ν ω
have UN_rule:"⋀ a S S'. (⋀n b. (a,b) ∈ S n ⟷ (a,b) ∈ S' n) ⟹ (⋀b. (a,b) ∈ (⋃n. S n) ⟷ (a,b) ∈ (⋃n. S' n))"
by auto
have eqL:"((ν, ω) ∈ prog_sem I (PsubstFO (a**) σ)) = ((ν, ω) ∈ (⋃n. (prog_sem I (PsubstFO a σ)) ^^ n))"
using rtrancl_is_UN_relpow by auto
moreover have eachEq:"⋀n. ((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PsubstFO a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjointFO I σ ν) a)^^ n)))"
proof -
fix n
show "((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PsubstFO a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjointFO I σ ν) a)^^ n)))"
proof (induct n)
case 0
then show ?case by auto
next
case (Suc n) then
have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ) ^^ n) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a ^^ n)"
by auto
have relpow:"⋀R n. R ^^ Suc n = R O R ^^ n"
using relpow.simps(2) relpow_commute by metis
show ?case
apply (simp only: relpow[of n "prog_sem I (PsubstFO a σ)"] relpow[of n "prog_sem (adjointFO I σ ν) a"])
apply(unfold relcomp_unfold)
apply auto
subgoal for ab b
apply(rule exI[where x=ab])
apply(rule exI[where x=b])
using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
done
subgoal for ab b
apply(rule exI[where x=ab])
apply(rule exI[where x=b])
using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
using uadmit_prog_ntadjoint[OF PUA agree ssafe hpsafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
done
done
qed
qed
moreover have "((ν, ω) ∈ (⋃n. (prog_sem I (PsubstFO a σ)) ^^ n)) = ((ν, ω) ∈ (⋃ n.(prog_sem (adjointFO I σ ν) a)^^ n))"
apply(rule UN_rule)
using eachEq by auto
moreover have eqR:"((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a**)) = ((ν, ω) ∈ (⋃n. (prog_sem (adjointFO I σ ν) a) ^^ n))"
using rtrancl_is_UN_relpow by auto
ultimately show "((ν, ω) ∈ prog_sem I (PsubstFO (a**) σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) (a**))"
by auto
qed
then show ?case by auto
next
case (NFadmit_Exists σ φ x)
then have IH:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
and FUA:"FUadmitFO σ φ {Inl x}"
by blast+
have fsafe:"fsafe (Exists x φ) ⟹ fsafe φ"
by (auto dest: fsafe.cases)
have eq:"fsafe (Exists x φ) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO (Exists x φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) (Exists x φ)))"
proof -
assume fsafe:"fsafe (Exists x φ)"
from fsafe have fsafe':"fsafe φ" by (auto dest: fsafe.cases)
assume ssafe:"(⋀i. dsafe (σ i))"
fix ν
have agree:"⋀r. Vagree ν (repv ν x r) (- {Inl x})"
unfolding Vagree_def by auto
have sem_eq:"⋀r. ((repv ν x r) ∈ fml_sem (adjointFO I σ (repv ν x r)) φ) =
((repv ν x r) ∈ fml_sem (adjointFO I σ ν) φ)"
using uadmit_fml_ntadjoint[OF FUA agree ssafe fsafe' good_interp] by auto
have "(ν ∈ fml_sem I (FsubstFO (Exists x φ) σ)) = (∃r. (repv ν x r) ∈ fml_sem I (FsubstFO φ σ))"
by auto
moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (adjointFO I σ (repv ν x r)) φ)"
using IH[OF fsafe' ssafe] by auto
moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (adjointFO I σ ν) φ)"
using sem_eq by auto
moreover have "... = (ν ∈ fml_sem (adjointFO I σ ν) (Exists x φ))"
by auto
ultimately show "(ν ∈ fml_sem I (FsubstFO (Exists x φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) (Exists x φ))"
by auto
qed
then show ?case by auto
next
case (NFadmit_Diamond σ φ a) then
have PA:"NPadmit σ a"
and FUA:"FUadmitFO σ φ (BVP (PsubstFO a σ))"
and IH1:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
and IH2:"hpsafe a ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PsubstFO a σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) a))"
and hpsafeF:"hpsafe (PsubstFO a σ)"
by auto
have "fsafe (⟨ a ⟩ φ) ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO (⟨ a ⟩ φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) (⟨ a ⟩ φ)))"
proof -
assume fsafe:"fsafe (⟨ a ⟩ φ)"
assume ssafe:"(⋀i. dsafe (σ i))"
from fsafe have fsafe':"fsafe φ" and hpsafe:"hpsafe a" by (auto dest: fsafe.cases)
fix ν
have agree:"⋀ω. (ν, ω) ∈ prog_sem I (PsubstFO a σ) ⟹ Vagree ν ω (-BVP(PsubstFO a σ))"
using bound_effect[OF good_interp, of "(PsubstFO a σ)" ν, OF hpsafeF] by auto
have sem_eq:"⋀ω. (ν, ω) ∈ prog_sem I (PsubstFO a σ) ⟹
(ω ∈ fml_sem (adjointFO I σ ν) φ) =
(ω ∈ fml_sem (adjointFO I σ ω) φ)"
using uadmit_fml_ntadjoint [OF FUA agree ssafe fsafe' good_interp] by auto
have "(ν ∈ fml_sem I (FsubstFO (⟨ a ⟩ φ) σ)) = (∃ ω. (ν, ω) ∈ prog_sem I (PsubstFO a σ) ∧ ω ∈ fml_sem I (FsubstFO φ σ))"
by auto
moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjointFO I σ ν) a ∧ ω ∈ fml_sem (adjointFO I σ ω) φ)"
using IH1[OF fsafe' ssafe] IH2[OF hpsafe ssafe, of ν] by auto
moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjointFO I σ ν) a ∧ ω ∈ fml_sem (adjointFO I σ ν) φ)"
using sem_eq IH2 hpsafe ssafe by blast
moreover have "... = (ν ∈ fml_sem (adjointFO I σ ν) (⟨ a ⟩ φ))"
by auto
ultimately show "?thesis ν" by auto
qed
then show ?case by auto
next
case (NFadmit_Context σ φ C) then
have FA:"NFadmit σ φ"
and FUA:"FUadmitFO σ φ UNIV"
and IH:"fsafe φ ⟹ (⋀i. dsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ))"
by auto
have "fsafe (InContext C φ) ⟹
(⋀i. dsafe (σ i))⟹ (⋀ν. (ν ∈ fml_sem I (FsubstFO (InContext C φ) σ)) = (ν ∈ fml_sem (adjointFO I σ ν) (InContext C φ)))"
proof -
assume safe:"fsafe (InContext C φ)"
then have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
assume ssafe:"⋀i. dsafe (σ i)"
fix ν
have Ieq:" Contexts (adjointFO I σ ν) C = Contexts I C"
unfolding adjointFO_def by auto
have IH':"⋀ν. (ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ)"
using IH[OF fsafe ssafe] by auto
have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
have adj_eq:"⋀ω. fml_sem (adjointFO I σ ν) φ = fml_sem (adjointFO I σ ω) φ"
using uadmit_fml_ntadjoint[OF FUA agree ssafe fsafe good_interp] by auto
then have sem:"fml_sem I (FsubstFO φ σ) = fml_sem (adjointFO I σ ν) φ"
using IH' agree adj_eq by auto
show "?thesis ν" using Ieq sem by auto
qed
then show ?case by auto
qed (auto)
lemma nsubst_fml:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
assumes good_interp:"is_interp I"
assumes NFA:"NFadmit σ φ"
assumes fsafe:"fsafe φ"
assumes frees:"(∀i. dsafe (σ i))"
shows "(ν ∈ fml_sem I (FsubstFO φ σ)) = (ν ∈ fml_sem (adjointFO I σ ν) φ)"
using good_interp NFA fsafe frees
by (auto simp add: nsubst_hp_fml)
lemma nsubst_hp:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
assumes good_interp:"is_interp I"
assumes NPA:"NPadmit σ α"
assumes hpsafe:"hpsafe α"
assumes frees:"⋀i. dsafe (σ i)"
shows "((ν, ω) ∈ prog_sem I (PsubstFO α σ)) = ((ν, ω) ∈ prog_sem (adjointFO I σ ν) α)"
using good_interp NPA hpsafe frees nsubst_hp_fml by blast
lemma psubst_sterm:
fixes I::"('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"
shows "(sterm_sem I θ = sterm_sem (PFadjoint I σ) θ)"
proof (induction θ)
qed (auto simp add: PFadjoint_def)
lemma psubst_dterm:
fixes I::"('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"
shows "(dsafe θ ⟹ dterm_sem I θ = dterm_sem (PFadjoint I σ) θ)"
proof (induction θ)
case (Differential θ)
assume safe:"dsafe (Differential θ)"
from safe have free:"dfree θ" by auto
assume sem:"dsafe θ ⟹ dterm_sem I θ = dterm_sem (PFadjoint I σ) θ"
have "⋀ν. frechet I θ (fst ν) (snd ν) = frechet (PFadjoint I σ) θ (fst ν) (snd ν)"
apply(rule sterm_determines_frechet)
using good_interp free apply auto
subgoal unfolding is_interp_def PFadjoint_def by auto
using psubst_sterm[of I θ] by auto
then show "?case"
by (auto simp add: directional_derivative_def)
qed (auto simp add: PFadjoint_def)
lemma psubst_ode:
assumes good_interp:"is_interp I"
shows "ODE_sem I ODE = ODE_sem (PFadjoint I σ) ODE"
proof (induction "ODE")
case (OVar x)
then show ?case unfolding PFadjoint_def by auto
next
case (OSing x1a x2)
then show ?case apply auto apply (rule ext) apply (rule vec_extensionality) using psubst_sterm[OF good_interp, of x2 σ] by auto
next
case (OProd ODE1 ODE2)
then show ?case by auto
qed
lemma psubst_fml:
fixes I::"('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"
shows "(PPadmit σ α ⟶ hpsafe α ⟶ (∀i. fsafe (σ i)) ⟶ (∀ ν ω. (ν,ω) ∈ prog_sem I (PPsubst α σ) = ((ν,ω) ∈ prog_sem (PFadjoint I σ) α))) ∧
(PFadmit σ φ ⟶ fsafe φ ⟶ (∀i. fsafe (σ i)) ⟶ (∀ ν. ν ∈ fml_sem I (PFsubst φ σ) = (ν ∈ fml_sem (PFadjoint I σ) φ)))"
proof (induction rule: PPadmit_PFadmit.induct)
case (PPadmit_ODE σ φ ODE)
assume PF:"PFadmit σ φ"
assume PFU:"PFUadmit σ φ (BVO ODE)"
assume IH:"fsafe φ ⟶ (∀i. fsafe (σ i)) ⟶ (∀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ))"
have "hpsafe (EvolveODE ODE φ) ⟹
(∀i. fsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (EvolveODE ODE φ)))"
proof -
assume safe:"hpsafe (EvolveODE ODE φ)"
from safe have fsafe:"fsafe φ" by auto
assume ssafe:"(∀i. fsafe (σ i))"
have fml_eq:"⋀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ)"
using IH ssafe fsafe by auto
fix ν ω
show "((ν, ω) ∈ prog_sem I (PPsubst (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (EvolveODE ODE φ))"
apply auto
proof -
fix b sol t
assume eq1:"ν = (sol 0, b)"
and eq2:"ω = mk_v I ODE (sol 0, b) (sol t)"
and t:"0 ≤ t"
and sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ)}"
have var:"ODE_vars I ODE = ODE_vars (PFadjoint I σ) ODE"
by(induction ODE, auto simp add: PFadjoint_def)
have mkv_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I ODE (sol 0, b) (sol s) = mk_v (PFadjoint I σ) ODE (sol 0, b) (sol s)"
apply(rule agree_UNIV_eq)
unfolding Vagree_def apply auto
subgoal for s i
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
unfolding Vagree_def var
apply (cases "Inl i ∈ Inl ` ODE_vars I ODE", auto simp add: var)
by force
subgoal for s i
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
unfolding Vagree_def var
apply (cases "Inr i ∈ Inr ` ODE_vars I ODE", auto simp add: var psubst_ode)
using psubst_ode[OF good_interp, of ODE σ] apply auto
using psubst_ode[OF good_interp, of ODE σ] by force
done
have sol':"(sol solves_ode (λ_. ODE_sem (PFadjoint I σ) ODE)) {0..t}
{x. mk_v I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ)}"
apply (rule solves_ode_congI)
apply (rule sol)
subgoal for ta by auto
subgoal for ta using psubst_ode[OF good_interp, of ODE σ] by auto
subgoal by (rule refl)
subgoal by (rule refl)
done
have sub:"⋀s. s ∈ {0..t}
⟹ sol s ∈ {x. (mk_v (PFadjoint I σ ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ ) φ)}"
subgoal for s
using solves_ode_domainD[OF sol, of s] mkv_eq[of s] fml_eq[of "mk_v (PFadjoint I σ ) ODE (sol 0, b) (sol s)"]
by auto
done
have sol'':"(sol solves_ode (λc. ODE_sem (PFadjoint I σ ) ODE)) {0..t}
{x. mk_v (PFadjoint I σ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ ) φ}"
apply (rule solves_odeI)
subgoal using sol' solves_ode_vderivD by blast
using sub by auto
show"∃sola. sol 0 = sola 0 ∧
(∃ta. mk_v I ODE (sol 0, b) (sol t) = mk_v (PFadjoint I σ) ODE (sola 0, b) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODE_sem (PFadjoint I σ) ODE)) {0..ta}
{x. mk_v (PFadjoint I σ) ODE (sola 0, b) x ∈ fml_sem (PFadjoint I σ) φ})"
apply(rule exI[where x=sol])
apply(rule conjI)
apply(rule refl)
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkv_eq t by auto
apply(rule conjI)
apply(rule t)
apply(rule sol'')
done
next
fix b sol t
assume eq1:"ν = (sol 0, b)"
and eq2:"ω = mk_v (PFadjoint I σ) ODE (sol 0, b) (sol t)"
and t:"0 ≤ t"
and sol:"(sol solves_ode (λa. ODE_sem (PFadjoint I σ) ODE)) {0..t} {x. mk_v (PFadjoint I σ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ) φ}"
have var:"ODE_vars I ODE = ODE_vars (PFadjoint I σ) ODE"
by(induction ODE, auto simp add: PFadjoint_def)
have mkv_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I ODE (sol 0, b) (sol s) = mk_v (PFadjoint I σ) ODE (sol 0, b) (sol s)"
apply(rule agree_UNIV_eq)
unfolding Vagree_def apply auto
subgoal for s i
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
unfolding Vagree_def var
apply (cases "Inl i ∈ Inl ` ODE_vars I ODE", auto simp add: var)
by force
subgoal for s i
using mk_v_agree[of I ODE "(sol 0, b)" "sol s"] mk_v_agree[of "PFadjoint I σ" ODE "(sol 0, b)" "sol s"]
unfolding Vagree_def var
apply (cases "Inr i ∈ Inr ` ODE_vars I ODE", auto simp add: var psubst_ode)
using psubst_ode[OF good_interp, of ODE σ] apply auto
using psubst_ode[OF good_interp, of ODE σ] by force
done
have sol':"(sol solves_ode (λ_. ODE_sem I ODE)) {0..t}
{x. mk_v (PFadjoint I σ) ODE (sol 0, b) x ∈ fml_sem (PFadjoint I σ) φ}"
apply (rule solves_ode_congI)
apply (rule sol)
subgoal for ta by auto
subgoal for ta using psubst_ode[OF good_interp, of ODE σ] by auto
subgoal by (rule refl)
subgoal by (rule refl)
done
have sub:"⋀s. s ∈ {0..t}
⟹ sol s ∈ {x. (mk_v I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ))}"
subgoal for s
using solves_ode_domainD[OF sol, of s] mkv_eq[of s] fml_eq[of "mk_v (PFadjoint I σ ) ODE (sol 0, b) (sol s)"]
by auto
done
have sol'':"(sol solves_ode (λc. ODE_sem I ODE)) {0..t}
{x. mk_v I ODE (sol 0, b) x ∈ fml_sem I (PFsubst φ σ)}"
apply (rule solves_odeI)
subgoal using sol' solves_ode_vderivD by blast
using sub by auto
show "∃sola. sol 0 = sola 0 ∧
(∃ta. mk_v (PFadjoint I σ) ODE (sol 0, b) (sol t) = mk_v I ODE (sola 0, b) (sola ta) ∧
0 ≤ ta ∧ (sola solves_ode (λa. ODE_sem I ODE)) {0..ta} {x. mk_v I ODE (sola 0, b) x ∈ fml_sem I (PFsubst φ σ)})"
apply(rule exI[where x=sol])
by (metis dual_order.refl intervalE mkv_eq sol'' t)
qed
qed
then show ?case
by auto
next
case (PPadmit_Assign σ x θ)
have "hpsafe (x := θ) ⟹ (∀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (x := θ) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (x := θ)))"
proof -
assume safe:"hpsafe (x := θ)"
then have dsafe:"dsafe θ" by auto
assume safes:"(∀i. fsafe (σ i))"
show "?thesis"
using psubst_dterm[OF good_interp dsafe, of σ] by auto
qed
then show "?case" by auto
next
case (PPadmit_DiffAssign σ x θ)
have "hpsafe (DiffAssign x θ) ⟹ (∀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (DiffAssign x θ) σ)) = (((ν, ω) ∈ prog_sem (PFadjoint I σ) (DiffAssign x θ))))"
proof -
assume safe:"hpsafe (DiffAssign x θ)"
then have dsafe:"dsafe θ" by auto
assume safes:"(∀i. fsafe (σ i))"
show "?thesis"
using psubst_dterm[OF good_interp dsafe, of σ] by auto
qed
then show ?case by auto
next
case (PFadmit_Geq σ θ1 θ2) then
have "fsafe (Geq θ1 θ2) ⟹ (∀i. fsafe (σ i)) ⟹ (∀ ν. (ν ∈ fml_sem I (PFsubst (Geq θ1 θ2) σ)) = (ν ∈ fml_sem (PFadjoint I σ) (Geq θ1 θ2)))"
proof -
assume safe:"fsafe (Geq θ1 θ2)"
then have safe1:"dsafe θ1"
and safe2:"dsafe θ2" by auto
assume safes:"(∀i. fsafe (σ i))"
show "?thesis"
using psubst_dterm[OF good_interp safe1, of σ] psubst_dterm[OF good_interp safe2, of σ] by auto
qed
then show ?case by auto
next
case (PFadmit_Prop σ p args) then
have "fsafe (Prop p args) ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν.(ν ∈ fml_sem I (PFsubst ($φ p args) σ)) = (ν ∈ fml_sem (PFadjoint I σ) ($φ p args)))"
proof -
assume safe:"fsafe (Prop p args)" and ssafe:" (⋀i. fsafe (σ i))"
fix ν
from safe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
have Ieq:"Predicates I p = Predicates (PFadjoint I σ) p"
unfolding PFadjoint_def by auto
have vec:"(χ i. dterm_sem I (args i) ν) = (χ i. dterm_sem (PFadjoint I σ) (args i) ν)"
apply(auto simp add: vec_eq_iff)
subgoal for i using safes[of i]
by (metis good_interp psubst_dterm)
done
show "?thesis ν" using Ieq vec by auto
qed
then show "?case" by auto
next
case (PPadmit_Sequence σ a b) then
have PUA:"PPUadmit σ b (BVP (PPsubst a σ))"
and PA:"PPadmit σ a"
and IH1:"hpsafe a ⟹ (⋀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst a σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) a))"
and IH2:"hpsafe b ⟹ (⋀i. fsafe (σ i)) ⟹ (∀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst b σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) b))"
and substSafe:"hpsafe (PPsubst a σ)"
by auto
have "hpsafe (a ;; b) ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a ;; b)))"
proof -
assume hpsafe:"hpsafe (a ;; b)"
assume ssafe:"(⋀i. fsafe (σ i))"
from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by (auto dest: hpsafe.cases)
fix ν ω
have agree:"⋀μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ⟹ Vagree ν μ (-BVP(PPsubst a σ))"
subgoal for μ
using bound_effect[OF good_interp, of "(PPsubst a σ)" ν, OF substSafe] by auto
done
have sem_eq:"⋀μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ⟹
((μ, ω) ∈ prog_sem (PFadjoint I σ) b) =
((μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
subgoal for μ
proof -
assume assm:"(ν, μ) ∈ prog_sem I (PPsubst a σ)"
show "((μ, ω) ∈ prog_sem (PFadjoint I σ) b) = ((μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
using PUA agree[OF assm] safe2 ssafe good_interp by auto
qed
done
have "((ν, ω) ∈ prog_sem I (PPsubst (a ;; b) σ)) = (∃ μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ∧ (μ, ω) ∈ prog_sem I (PPsubst b σ))"
by auto
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ∧ (μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
using IH2[OF safe2 ssafe] by blast
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem (PFadjoint I σ) a ∧ (μ, ω) ∈ prog_sem (PFadjoint I σ) b)"
using IH1[OF safe1 ssafe] sem_eq by blast
ultimately
show "((ν, ω) ∈ prog_sem I (PPsubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a ;; b))"
by auto
qed
then show ?case by auto
next
case (PPadmit_Loop σ a) then
have PA:"PPadmit σ a"
and PUA:"PPUadmit σ a (BVP (PPsubst a σ))"
and IH:"hpsafe a ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst a σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) a))"
and substSafe:"hpsafe (PPsubst a σ)"
by auto
have "hpsafe (a**) ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst (a**) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a**)))"
proof -
assume "hpsafe (a**)"
then have hpsafe:"hpsafe a" by (auto dest: hpsafe.cases)
assume ssafe:"⋀i. fsafe (σ i)"
have agree:"⋀ν μ. (ν, μ) ∈ prog_sem I (PPsubst a σ) ⟹ Vagree ν μ (-BVP(PPsubst a σ))"
subgoal for ν μ
using bound_effect[OF good_interp, of "(PPsubst a σ)" ν, OF substSafe] by auto
done
fix ν ω
have UN_rule:"⋀ a S S'. (⋀n b. (a,b) ∈ S n ⟷ (a,b) ∈ S' n) ⟹ (⋀b. (a,b) ∈ (⋃n. S n) ⟷ (a,b) ∈ (⋃n. S' n))"
by auto
have eqL:"((ν, ω) ∈ prog_sem I (PPsubst (a**) σ)) = ((ν, ω) ∈ (⋃n. (prog_sem I (PPsubst a σ)) ^^ n))"
using rtrancl_is_UN_relpow by auto
moreover have eachEq:"⋀n. ((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PPsubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (PFadjoint I σ) a)^^ n)))"
proof -
fix n
show "((⋀ν ω. ((ν, ω) ∈ (prog_sem I (PPsubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (PFadjoint I σ) a)^^ n)))"
proof (induct n)
case 0
then show ?case by auto
next
case (Suc n) then
have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (PPsubst a σ) ^^ n) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) a ^^ n)"
by auto
have relpow:"⋀R n. R ^^ Suc n = R O R ^^ n"
using relpow.simps(2) relpow_commute by metis
show ?case
apply (simp only: relpow[of n "prog_sem I (PPsubst a σ)"] relpow[of n "prog_sem (PFadjoint I σ) a"])
apply(unfold relcomp_unfold)
apply auto
subgoal for ab b
apply(rule exI[where x=ab])
apply(rule exI[where x=b])
using IH2 IH[OF hpsafe ssafe] by auto
subgoal for ab b
apply(rule exI[where x=ab])
apply(rule exI[where x=b])
using IH2 IH[OF hpsafe ssafe] by auto
done
qed
qed
moreover have "((ν, ω) ∈ (⋃n. (prog_sem I (PPsubst a σ)) ^^ n)) = ((ν, ω) ∈ (⋃ n.(prog_sem (PFadjoint I σ) a)^^ n))"
apply(rule UN_rule)
using eachEq by auto
moreover have eqR:"((ν, ω) ∈ prog_sem (PFadjoint I σ) (a**)) = ((ν, ω) ∈ (⋃n. (prog_sem (PFadjoint I σ) a) ^^ n))"
using rtrancl_is_UN_relpow by auto
ultimately show "((ν, ω) ∈ prog_sem I (PPsubst (a**) σ)) = ((ν, ω) ∈ prog_sem (PFadjoint I σ) (a**))"
by auto
qed
then show ?case by auto
next
next
case (PFadmit_Context σ φ C) then
have FA:"PFadmit σ φ"
and FUA:"PFUadmit σ φ UNIV"
and IH:"fsafe φ ⟹ (⋀i. fsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ))"
by auto
have "fsafe (InContext C φ) ⟹
(⋀i. fsafe (σ i)) ⟹ (⋀ν. (ν ∈ fml_sem I (PFsubst (InContext C φ) σ)) = (ν ∈ fml_sem (PFadjoint I σ) (InContext C φ)))"
proof -
assume safe:"fsafe (InContext C φ)"
then have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
assume ssafe:"(⋀i. fsafe (σ i))"
fix ν :: "(real, 'sz) vec × (real, 'sz) vec"
have IH':"⋀ν. (ν ∈ fml_sem I (PFsubst φ σ)) = (ν ∈ fml_sem (PFadjoint I σ) φ)"
using IH[OF fsafe ssafe] by auto
have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
then have sem:"fml_sem I (PFsubst φ σ) = fml_sem (PFadjoint I σ) φ"
using IH' agree by auto
show "?thesis ν" using sem
apply auto
apply(cases C)
unfolding PFadjoint_def apply auto
apply(cases C)
by auto
qed
then show ?case by auto
qed (auto simp add: PFadjoint_def)
lemma subst_ode:
fixes I:: "('sf, 'sc, 'sz) interp" and ν :: "'sz state"
assumes good_interp:"is_interp I"
shows "osafe ODE ⟹
ssafe σ ⟹
Oadmit σ ODE (BVO ODE) ⟹
ODE_sem I (Osubst ODE σ) (fst ν) = ODE_sem (adjoint I σ ν) ODE (fst ν)"
proof (induction rule: osafe.induct)
case (osafe_Var c)
then show ?case unfolding adjoint_def by (cases "SODEs σ c", auto)
next
case (osafe_Sing θ x)
then show ?case
using subst_sterm [of σ θ I "ν"]
unfolding ssafe_def by auto
next
case (osafe_Prod ODE1 ODE2) then
have NOU1:"Oadmit σ ODE1 (BVO (OProd ODE1 ODE2))" and NOU2:"Oadmit σ ODE2 (BVO (OProd ODE1 ODE2))"
by auto
have TUA_sub:"⋀σ θ A B. TUadmit σ θ B ⟹ A ⊆ B ⟹ TUadmit σ θ A"
unfolding TUadmit_def by auto
have OA_sub:"⋀ODE A B. Oadmit σ ODE B ⟹ A ⊆ B ⟹ Oadmit σ ODE A"
subgoal for ODE A B
proof (induction rule: Oadmit.induct)
case (Oadmit_Var σ c U)
then show ?case by auto
next
case (Oadmit_Sing σ θ U x)
then show ?case using TUA_sub[of σ θ U A] by auto
next
case (Oadmit_Prod σ ODE1 U ODE2)
then show ?case by auto
qed
done
have sub1:"(BVO ODE1) ⊆ (BVO (OProd ODE1 ODE2))"
by auto
have sub2: "(BVO ODE2) ⊆ (BVO (OProd ODE1 ODE2))"
by auto
have "ODE_sem I (Osubst ODE1 σ) (fst ν) = ODE_sem (adjoint I σ ν) ODE1 (fst ν)"
"ODE_sem I (Osubst ODE2 σ) (fst ν) = ODE_sem (adjoint I σ ν) ODE2 (fst ν)" using osafe_Prod.IH osafe_Prod.prems osafe_Prod.hyps
using OA_sub[OF NOU1 sub1] OA_sub[OF NOU2 sub2] by auto
then show ?case by auto
qed
lemma osubst_eq_ODE_vars: "ODE_vars I (Osubst ODE σ) = ODE_vars (adjoint I σ ν) ODE"
proof (induction ODE)
case (OVar x)
then show ?case by (cases "SODEs σ x", auto simp add: adjoint_def)
qed (auto)
lemma subst_semBV:"semBV (adjoint I σ ν') ODE = (semBV I (Osubst ODE σ))"
proof (induction ODE)
case (OVar x)
then show ?case by (cases "SODEs σ x", auto simp add: adjoint_def)
qed (auto)
lemma subst_mkv:
fixes I::"('sf, 'sc, 'sz) interp"
fixes ν::"'sz state"
fixes ν'::"'sz state"
assumes good_interp:"is_interp I"
assumes NOU:"Oadmit σ ODE (BVO ODE)"
assumes osafe:"osafe ODE "
assumes frees:"ssafe σ"
shows "(mk_v I (Osubst ODE σ) ν (fst ν'))
= (mk_v (adjoint I σ ν') ODE ν (fst ν'))"
apply(rule agree_UNIV_eq)
using mk_v_agree[of "adjoint I σ ν'" "ODE" ν "fst ν'"]
using mk_v_agree[of "I" "Osubst ODE σ" ν "fst ν'"]
unfolding Vagree_def
using subst_ode[OF good_interp osafe frees NOU, of ν']
apply auto
subgoal for i
apply(erule allE[where x=i])+
apply(cases "Inl i ∈ Inl ` ODE_vars (adjoint I σ ν') ODE")
using osubst_eq_ODE_vars[of I ODE σ ν']
apply force
proof -
assume "ODE_sem I (Osubst ODE σ) (fst ν') = ODE_sem (local.adjoint I σ ν') ODE (fst ν')"
"Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ν') ODE ∧ Inl i ∉ Inr ` ODE_vars (local.adjoint I σ ν') ODE ⟶
fst (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i = fst ν $ i"
"Inl i ∉ Inl ` ODE_vars I (Osubst ODE σ) ∧ Inl i ∉ Inr ` ODE_vars I (Osubst ODE σ) ⟶
fst (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = fst ν $ i"
"Inl i ∉ Inl ` ODE_vars (local.adjoint I σ ν') ODE"
then show
"fst (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = fst (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i"
using osubst_eq_ODE_vars[of I ODE σ ν'] by force
qed
subgoal for i
apply(erule allE[where x=i])+
apply(cases "Inr i ∈ Inr ` ODE_vars (adjoint I σ ν') ODE")
using osubst_eq_ODE_vars[of I ODE σ ν']
apply force
proof -
assume "ODE_sem I (Osubst ODE σ) (fst ν') = ODE_sem (local.adjoint I σ ν') ODE (fst ν')"
"Inr i ∉ Inl ` ODE_vars (local.adjoint I σ ν') ODE ∧ Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ν') ODE ⟶
snd (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i = snd ν $ i"
"Inr i ∉ Inl ` ODE_vars I (Osubst ODE σ) ∧ Inr i ∉ Inr ` ODE_vars I (Osubst ODE σ) ⟶
snd (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = snd ν $ i"
"Inr i ∉ Inr ` ODE_vars (local.adjoint I σ ν') ODE"
then show "snd (mk_v I (Osubst ODE σ) ν (fst ν')) $ i = snd (mk_v (local.adjoint I σ ν') ODE ν (fst ν')) $ i"
using osubst_eq_ODE_vars[of I ODE σ ν'] by force
qed
done
lemma subst_fml_hp:
fixes I::"('sf, 'sc, 'sz) interp"
assumes good_interp:"is_interp I"
shows
"(Padmit σ α ⟶
(hpsafe α ⟶
ssafe σ ⟶
(∀ ν ω. ((ν, ω) ∈ prog_sem I (Psubst α σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) α))))
∧
(Fadmit σ φ ⟶
(fsafe φ ⟶
ssafe σ ⟶
(∀ ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ))))"
proof (induction rule: Padmit_Fadmit.induct)
case (Padmit_Pvar σ a) then
have "hpsafe ($α a) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst ($α a) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) ($α a)))"
apply (cases "SPrograms σ a")
unfolding adjoint_def by auto
then show ?case by auto
next
case (Padmit_Sequence σ a b) then
have PUA:"PUadmit σ b (BVP (Psubst a σ))"
and PA:"Padmit σ a"
and IH1:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a))"
and IH2:"hpsafe b ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst b σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) b))"
and substSafe:"hpsafe (Psubst a σ)"
by auto
have "hpsafe (a ;; b) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a ;; b)))"
proof -
assume hpsafe:"hpsafe (a ;; b)"
assume ssafe:"ssafe σ"
from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by (auto dest: hpsafe.cases)
fix ν ω
have agree:"⋀μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹ Vagree ν μ (-BVP(Psubst a σ))"
subgoal for μ
using bound_effect[OF good_interp, of "(Psubst a σ)" ν, OF substSafe] by auto
done
have sem_eq:"⋀μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹
((μ, ω) ∈ prog_sem (local.adjoint I σ ν) b) =
((μ, ω) ∈ prog_sem (local.adjoint I σ μ) b)"
subgoal for μ
proof -
assume assm:"(ν, μ) ∈ prog_sem I (Psubst a σ)"
show "((μ, ω) ∈ prog_sem (local.adjoint I σ ν) b) = ((μ, ω) ∈ prog_sem (local.adjoint I σ μ) b)"
using uadmit_prog_adjoint[OF PUA agree[OF assm] safe2 ssafe good_interp] by auto
qed
done
have "((ν, ω) ∈ prog_sem I (Psubst (a ;; b) σ)) = (∃ μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ∧ (μ, ω) ∈ prog_sem I (Psubst b σ))"
by auto
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ∧ (μ, ω) ∈ prog_sem (adjoint I σ μ) b)"
using IH2[OF safe2 ssafe] by auto
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ∧ (μ, ω) ∈ prog_sem (adjoint I σ ν) b)"
using sem_eq by auto
moreover have "... = (∃ μ. (ν, μ) ∈ prog_sem (adjoint I σ ν) a ∧ (μ, ω) ∈ prog_sem (adjoint I σ ν) b)"
using IH1[OF safe1 ssafe] by auto
ultimately
show "((ν, ω) ∈ prog_sem I (Psubst (a ;; b) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a ;; b))"
by auto
qed
then show ?case by auto
next
case (Padmit_Loop σ a) then
have PA:"Padmit σ a"
and PUA:"PUadmit σ a (BVP (Psubst a σ))"
and IH:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a))"
and substSafe:"hpsafe (Psubst a σ)"
by auto
have "hpsafe (a**) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (a**) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a**)))"
proof -
assume "hpsafe (a**)"
then have hpsafe:"hpsafe a" by (auto dest: hpsafe.cases)
assume ssafe:"ssafe σ"
have agree:"⋀ν μ. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹ Vagree ν μ (-BVP(Psubst a σ))"
subgoal for ν μ
using bound_effect[OF good_interp, of "(Psubst a σ)" ν, OF substSafe] by auto
done
have sem_eq:"⋀ν μ ω. (ν, μ) ∈ prog_sem I (Psubst a σ) ⟹
((μ, ω) ∈ prog_sem (local.adjoint I σ ν) a) =
((μ, ω) ∈ prog_sem (local.adjoint I σ μ) a)"
subgoal for ν μ ω
proof -
assume assm:"(ν, μ) ∈ prog_sem I (Psubst a σ)"
show "((μ, ω) ∈ prog_sem (local.adjoint I σ ν) a) = ((μ, ω) ∈ prog_sem (local.adjoint I σ μ) a)"
using uadmit_prog_adjoint[OF PUA agree[OF assm] hpsafe ssafe good_interp] by auto
qed
done
fix ν ω
have UN_rule:"⋀ a S S'. (⋀n b. (a,b) ∈ S n ⟷ (a,b) ∈ S' n) ⟹ (⋀b. (a,b) ∈ (⋃n. S n) ⟷ (a,b) ∈ (⋃n. S' n))"
by auto
have eqL:"((ν, ω) ∈ prog_sem I (Psubst (a**) σ)) = ((ν, ω) ∈ (⋃n. (prog_sem I (Psubst a σ)) ^^ n))"
using rtrancl_is_UN_relpow by auto
moreover have eachEq:"⋀n. ((⋀ν ω. ((ν, ω) ∈ (prog_sem I (Psubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjoint I σ ν) a)^^ n)))"
proof -
fix n
show "((⋀ν ω. ((ν, ω) ∈ (prog_sem I (Psubst a σ)) ^^ n) = ((ν, ω) ∈ (prog_sem (adjoint I σ ν) a)^^ n)))"
proof (induct n)
case 0
then show ?case by auto
next
case (Suc n) then
have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ) ^^ n) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a ^^ n)"
by auto
have relpow:"⋀R n. R ^^ Suc n = R O R ^^ n"
using relpow.simps(2) relpow_commute by metis
show ?case
apply (simp only: relpow[of n "prog_sem I (Psubst a σ)"] relpow[of n "prog_sem (adjoint I σ ν) a"])
apply(unfold relcomp_unfold)
apply auto
subgoal for ab b
apply(rule exI[where x=ab])
apply(rule exI[where x=b])
using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
done
subgoal for ab b
apply(rule exI[where x=ab])
apply(rule exI[where x=b])
using IH2 IH[OF hpsafe ssafe] sem_eq[of ν "(ab,b)" ω] apply auto
using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
using uadmit_prog_adjoint[OF PUA agree hpsafe ssafe good_interp] IH[OF hpsafe ssafe]
apply (metis (no_types, lifting))
done
done
qed
qed
moreover have "((ν, ω) ∈ (⋃n. (prog_sem I (Psubst a σ)) ^^ n)) = ((ν, ω) ∈ (⋃ n.(prog_sem (adjoint I σ ν) a)^^ n))"
apply(rule UN_rule)
using eachEq by auto
moreover have eqR:"((ν, ω) ∈ prog_sem (adjoint I σ ν) (a**)) = ((ν, ω) ∈ (⋃n. (prog_sem (adjoint I σ ν) a) ^^ n))"
using rtrancl_is_UN_relpow by auto
ultimately show "((ν, ω) ∈ prog_sem I (Psubst (a**) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (a**))"
by auto
qed
then show ?case by auto
next
case (Padmit_ODE σ ODE φ) then
have OA:"Oadmit σ ODE (BVO ODE)"
and FA:"Fadmit σ φ"
and FUA:"FUadmit σ φ (BVO ODE)"
and IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
by auto
have "hpsafe (EvolveODE ODE φ) ⟹
ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (EvolveODE ODE φ) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (EvolveODE ODE φ)))"
proof (auto)
fix aa ba bb
and sol :: "real ⇒(real, 'sz) vec"
and t :: real
assume ssafe:"ssafe σ"
assume osafe:"osafe ODE"
assume fsafe:"fsafe φ"
assume t:"0 ≤ t"
assume eq:"(aa,ba) = mk_v I (Osubst ODE σ) (sol 0, bb) (sol t)"
assume sol:"(sol solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..t}
{x. mk_v I (Osubst ODE σ) (sol 0, bb) x ∈ fml_sem I (Fsubst φ σ)}"
have silly:"
⋀t. mk_v I (Osubst ODE σ) (sol 0, bb) (sol t) = mk_v (local.adjoint I σ (sol t, bb)) ODE (sol 0, bb) (sol t)"
subgoal for t using subst_mkv[OF good_interp OA osafe ssafe, of "(sol 0, bb)" "(sol t, bb)"] by auto done
have hmmsubst:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (-(BVO (Osubst ODE σ)))"
subgoal for s
apply (rule ODE_bound_effect[of s])
apply auto[1]
by (rule sol)
done
have sub:"(-(BVO ODE)) ⊆ (-(BVO (Osubst ODE σ)))"
by(induction ODE, auto)
have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (-(BVO ODE))"
subgoal for s
using agree_sub[OF sub hmmsubst[of s]] by auto
done
from hmm have hmm':"⋀s. s ∈ {0..t} ⟹ VSagree (sol 0) (sol s) {x. Inl x ∈ (-(BVO ODE))}"
unfolding VSagree_def Vagree_def by auto
note hmmm = hmmsubst
from hmmm have hmmm':"⋀s. s ∈ {0..t} ⟹ VSagree (sol 0) (sol s) {x. Inl x ∈ (-(BVO (Osubst ODE σ)))}"
unfolding VSagree_def Vagree_def by auto
have Vagree_of_VSagree:"⋀ν1 ν2 ω1 ω2 S. VSagree ν1 ν2 {x. Inl x ∈ S} ⟹ VSagree ω1 ω2 {x. Inr x ∈ S} ⟹ Vagree (ν1, ω1) (ν2, ω2) S"
unfolding VSagree_def Vagree_def by auto
have mkv:"⋀s. s ∈ {0..t} ⟹ mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s)"
subgoal for s by (rule silly[of s])
done
have lem:"⋀ODE. Oadmit σ ODE (BVO ODE) ⟹ (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
subgoal for ODE
apply(induction rule: Oadmit.induct)
apply auto
subgoal for σ θ U x xa
apply (cases "SFunctions σ xa")
apply auto
unfolding TUadmit_def
proof -
fix a
assume un:"(⋃i∈SIGT θ. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
assume sig:"xa ∈ SIGT θ"
assume some:"SFunctions σ xa = Some a"
assume fvt:"x ∈ FVT a"
assume xU:"x ∈ U"
from un sig have "(case SFunctions σ xa of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
by auto
then have "(FVT a) ∩ U = {}"
using some by auto
then show "False" using fvt xU by auto
qed
done
done
have FVT_sub:"(⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
using lem[OF OA] by auto
have agrees: "⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x)"
subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
have "⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol 0, bb)) ODE = mk_v (adjoint I σ (sol s, bb)) ODE"
subgoal for s
apply (rule uadmit_mkv_adjoint)
prefer 3
subgoal using agrees by auto
using OA hmm[of s] unfolding Vagree_def
using ssafe good_interp osafe by auto
done
then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s)"
by presburger
have main_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) "
using mkv mkva by auto
note mkvt = main_eq[of t]
have fml_eq1:"⋀s. s ∈ {0..t} ⟹
(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ))
= (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)"
using IH[OF fsafe ssafe] by auto
have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV I (Osubst ODE σ))"
subgoal for s
using mk_v_agree[of I "Osubst ODE σ" "(sol 0,bb)" "sol s"] osubst_eq_ODE_vars[of I ODE σ]
unfolding Vagree_def
by auto
done
have sembv_eq:"semBV I (Osubst ODE σ) = semBV (adjoint I σ (sol 0, bb)) ODE"
using subst_semBV by auto
have fml_vagree':"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV (adjoint I σ (sol 0,bb)) ODE)"
using sembv_eq fml_vagree by auto
have mysub:"-BVO ODE ⊆ -(semBV I (Osubst ODE σ))"
by(induction ODE,auto)
have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- BVO ODE)"
subgoal for s using agree_sub[OF mysub fml_vagree[of s]] by auto done
have fml_sem_eq:"⋀s. s ∈ {0..t} ⟹ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ = fml_sem (adjoint I σ (sol 0, bb)) φ"
apply (rule uadmit_fml_adjoint)
using FUA fsafe ssafe good_interp fml_vagree by auto
have fml_eq2:"⋀s. s ∈ {0..t} ⟹
((mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)
=(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ))"
using fml_sem_eq by auto
have fml_eq3:"⋀s. s ∈ {0..t} ⟹
(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) = (mk_v (adjoint I σ (sol 0,bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) "
using main_eq by auto
have fml_eq: "⋀s. s ∈ {0..t} ⟹
(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ))
= (mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ)"
using fml_eq1 fml_eq2 fml_eq3 by meson
have sem_eq:"⋀t. ODE_sem I (Osubst ODE σ) (sol t) = ODE_sem (adjoint I σ (sol t, bb)) ODE (sol t)"
subgoal for t
using subst_ode[OF good_interp osafe ssafe OA, of "(sol t,bb)"] by auto
done
have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (Osubst ODE σ) (sol s) = ODE_sem (adjoint I σ (sol 0, bb)) ODE (sol s)"
subgoal for s
using subst_ode[OF good_interp osafe ssafe OA, of "(sol s, bb)"]
uadmit_ode_adjoint'[OF ssafe good_interp agrees[of s] osafe]
by auto
done
have sol':"(sol solves_ode (λ_. ODE_sem (adjoint I σ (sol 0, bb)) ODE)) {0..t}
{x. mk_v I (Osubst ODE σ) (sol 0, bb) x ∈ fml_sem I (Fsubst φ σ)}"
apply (rule solves_ode_congI)
apply (rule sol)
subgoal for ta by auto
subgoal for ta by (rule sem_fact[of ta])
subgoal by (rule refl)
subgoal by (rule refl)
done
have sub:"⋀s. s ∈ {0..t}
⟹ sol s ∈ {x. (mk_v (adjoint I σ (sol 0,bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ)}"
using fml_eq rangeI t sol solves_ode_domainD by fastforce
have sol'':"(sol solves_ode (λc. ODE_sem (adjoint I σ (sol 0, bb)) ODE)) {0..t}
{x. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ}"
apply (rule solves_odeI)
subgoal using sol' solves_ode_vderivD by blast
using sub by auto
show "∃sola. sol 0 = sola 0 ∧
(∃ta. mk_v I (Osubst ODE σ) (sol 0, bb) (sol t) = mk_v (local.adjoint I σ (sol 0, bb)) ODE (sola 0, bb) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODE_sem (local.adjoint I σ (sol 0, bb)) ODE)) {0..ta}
{x. mk_v (local.adjoint I σ (sol 0, bb)) ODE (sola 0, bb) x ∈ fml_sem (local.adjoint I σ (sol 0, bb)) φ})"
apply(rule exI[where x=sol])
apply(rule conjI)
subgoal by (rule refl)
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkvt t by auto
apply(rule conjI)
subgoal by (rule t)
subgoal by (rule sol'')
done
next
fix aa ba bb
and sol::"real ⇒ (real, 'sz) vec"
and t::real
assume ssafe:"ssafe σ"
assume osafe:"osafe ODE"
assume fsafe:"fsafe φ"
assume eq:"(aa,ba) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol t)"
assume t:"0 ≤ t"
assume sol:"(sol solves_ode (λa. ODE_sem (adjoint I σ (sol 0, bb)) ODE)) {0..t}
{x. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ}"
have silly:"
⋀t. mk_v I (Osubst ODE σ) (sol 0, bb) (sol t) = mk_v (local.adjoint I σ (sol t, bb)) ODE (sol 0, bb) (sol t)"
subgoal for t using subst_mkv[OF good_interp OA osafe ssafe, of "(sol 0, bb)" "(sol t, bb)"] by auto done
have hmm:"⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (-(BVO ODE))"
subgoal for s
apply (rule ODE_bound_effect[of s])
apply auto[1]
by (rule sol)
done
from hmm have hmm':"⋀s. s ∈ {0..t} ⟹ VSagree (sol 0) (sol s) {x. Inl x ∈ (-(BVO ODE))}"
unfolding VSagree_def Vagree_def by auto
have Vagree_of_VSagree:"⋀ν1 ν2 ω1 ω2 S. VSagree ν1 ν2 {x. Inl x ∈ S} ⟹ VSagree ω1 ω2 {x. Inr x ∈ S} ⟹ Vagree (ν1, ω1) (ν2, ω2) S"
unfolding VSagree_def Vagree_def by auto
have mkv:"⋀s. s ∈ {0..t} ⟹ mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s)"
subgoal for s by (rule silly[of s])
done
have lem:"⋀ODE. Oadmit σ ODE (BVO ODE) ⟹ (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
subgoal for ODE
apply(induction rule: Oadmit.induct)
apply auto
subgoal for σ θ U x xa
apply (cases "SFunctions σ xa")
apply auto
unfolding TUadmit_def
proof -
fix a
assume un:"(⋃i∈SIGT θ. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
assume sig:"xa ∈ SIGT θ"
assume some:"SFunctions σ xa = Some a"
assume fvt:"x ∈ FVT a"
assume xU:"x ∈ U"
from un sig have "(case SFunctions σ xa of None ⇒ {} | Some x ⇒ FVT x) ∩ U = {}"
by auto
then have "(FVT a) ∩ U = {}"
using some by auto
then show "False" using fvt xU by auto
qed
done
done
have FVT_sub:"(⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x) ⊆ (-(BVO ODE))"
using lem[OF OA] by auto
have agrees: "⋀s. s ∈ {0..t} ⟹ Vagree (sol 0,bb) (sol s, bb) (⋃i∈{i |i. Inl i ∈ SIGO ODE}. case SFunctions σ i of None ⇒ {} | Some x ⇒ FVT x)"
subgoal for s using agree_sub[OF FVT_sub hmm[of s]] by auto done
have "⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol 0, bb)) ODE = mk_v (adjoint I σ (sol s, bb)) ODE"
subgoal for s
apply (rule uadmit_mkv_adjoint)
prefer 3
subgoal using agrees by auto
using OA hmm[of s] unfolding Vagree_def
using ssafe good_interp osafe by auto
done
then have mkva:"⋀s. s ∈ {0..t} ⟹ mk_v (adjoint I σ (sol s, bb)) ODE (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s)"
by presburger
have main_eq:"⋀s. s ∈ {0..t} ⟹ mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) = mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) "
using mkv mkva by auto
note mkvt = main_eq[of t]
have fml_eq1:"⋀s. s ∈ {0..t} ⟹
(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ))
= (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)"
using IH[OF fsafe ssafe] by auto
have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV I (Osubst ODE σ))"
subgoal for s
using mk_v_agree[of I "Osubst ODE σ" "(sol 0,bb)" "sol s"] osubst_eq_ODE_vars[of I ODE σ]
unfolding Vagree_def
by auto
done
have sembv_eq:"semBV I (Osubst ODE σ) = semBV (adjoint I σ (sol 0, bb)) ODE"
using subst_semBV by auto
have fml_vagree':"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- semBV (adjoint I σ (sol 0,bb)) ODE)"
using sembv_eq fml_vagree by auto
have mysub:"-BVO ODE ⊆ -(semBV I (Osubst ODE σ))"
by(induction ODE,auto)
have fml_vagree:"⋀s. s ∈ {0..t} ⟹ Vagree (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s)) (sol 0, bb) (- BVO ODE)"
subgoal for s using agree_sub[OF mysub fml_vagree[of s]] by auto done
have fml_sem_eq:"⋀s. s ∈ {0..t} ⟹ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ = fml_sem (adjoint I σ (sol 0, bb)) φ"
apply (rule uadmit_fml_adjoint)
using FUA fsafe ssafe good_interp fml_vagree by auto
have fml_eq2:"⋀s. s ∈ {0..t} ⟹
((mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (mk_v I (Osubst ODE σ) (sol 0, bb) (sol s))) φ)
=(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ))"
using fml_sem_eq by auto
have fml_eq3:"⋀s. s ∈ {0..t} ⟹
(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) = (mk_v (adjoint I σ (sol 0,bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ) "
using main_eq by auto
have fml_eq: "⋀s. s ∈ {0..t} ⟹
(mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ))
= (mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol s) ∈ fml_sem (adjoint I σ (sol 0, bb)) φ)"
using fml_eq1 fml_eq2 fml_eq3 by meson
have sem_eq:"⋀t. ODE_sem I (Osubst ODE σ) (sol t) = ODE_sem (adjoint I σ (sol t, bb)) ODE (sol t)"
subgoal for t
using subst_ode[OF good_interp osafe ssafe OA, of "(sol t,bb)"] by auto
done
have sem_fact:"⋀s. s ∈ {0..t} ⟹ ODE_sem I (Osubst ODE σ) (sol s) = ODE_sem (adjoint I σ (sol 0, bb)) ODE (sol s)"
subgoal for s
using subst_ode[OF good_interp osafe ssafe OA, of "(sol s, bb)"]
uadmit_ode_adjoint'[OF ssafe good_interp agrees[of s] osafe]
by auto
done
have sub:"⋀s. s ∈ {0..t}
⟹ sol s ∈ {x. mk_v I (Osubst ODE σ) (sol 0, bb) (sol s) ∈ fml_sem I (Fsubst φ σ)}"
using fml_eq rangeI t sol solves_ode_domainD by fastforce
have sol':"(sol solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..t} {x. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) x ∈ fml_sem (adjoint I σ (sol 0, bb)) φ}"
apply (rule solves_ode_congI)
apply (rule sol)
subgoal for ta by auto
subgoal for ta using sem_fact[of ta] by auto
subgoal by (rule refl)
subgoal by (rule refl)
done
have sol'':"(sol solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..t} {x. mk_v I (Osubst ODE σ) (sol 0, bb) x ∈ fml_sem I (Fsubst φ σ)}"
apply (rule solves_odeI)
subgoal using sol' solves_ode_vderivD by blast
subgoal for ta using sub[of ta] apply auto
by (meson empty_iff)
done
show "∃sola. sol 0 = sola 0 ∧
(∃ta. mk_v (adjoint I σ (sol 0, bb)) ODE (sol 0, bb) (sol t) = mk_v I (Osubst ODE σ) (sola 0, bb) (sola ta) ∧
0 ≤ ta ∧
(sola solves_ode (λa. ODE_sem I (Osubst ODE σ))) {0..ta} {x. mk_v I (Osubst ODE σ) (sola 0, bb) x ∈ fml_sem I (Fsubst φ σ)})"
apply(rule exI[where x=sol])
apply(rule conjI)
subgoal by (rule refl)
apply(rule exI[where x=t])
apply(rule conjI)
subgoal using mkvt t by auto
apply(rule conjI)
subgoal by (rule t)
subgoal using sol'' by auto
done
qed
then show "?case" by auto
next
case (Padmit_Choice σ a b) then
have IH1:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) a))"
and IH2:"hpsafe b ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst b σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) b))"
by blast+
have hpsafe1:"hpsafe (a ∪∪ b) ⟹ hpsafe a"
and hpsafe2:"hpsafe (a ∪∪ b) ⟹ hpsafe b"
by (auto dest: hpsafe.cases)
show ?case using IH1[OF hpsafe1] IH2[OF hpsafe2] by auto
next
case (Padmit_Assign σ θ x) then
have TA:"Tadmit σ θ" by auto
have "hpsafe (Assign x θ) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (Assign x θ) σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) (Assign x θ)))"
proof -
assume hpsafe:"hpsafe (Assign x θ)"
assume ssafe:"ssafe σ"
from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
unfolding ssafe_def by auto
from hpsafe have dsafe:"dsafe θ" by (auto elim: hpsafe.cases)
fix ν ω
show "?thesis ν ω"
using subst_dterm[OF good_interp TA dsafe ssafes]
by auto
qed
then show ?case by auto
next
case (Padmit_DiffAssign σ θ x) then
have TA:"Tadmit σ θ" by auto
have "hpsafe (DiffAssign x θ) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (DiffAssign x θ) σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) (DiffAssign x θ)))"
proof -
assume hpsafe:"hpsafe (DiffAssign x θ)"
assume ssafe:"ssafe σ"
from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
unfolding ssafe_def by auto
from hpsafe have dsafe:"dsafe θ" by (auto elim: hpsafe.cases)
fix ν ω
show "?thesis ν ω"
using subst_dterm[OF good_interp TA dsafe ssafes]
by auto
qed
then show ?case by auto
next
case (Padmit_Test σ φ) then
have IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
by auto
have "hpsafe (? φ) ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst (? φ) σ)) = ((ν, ω) ∈ prog_sem (local.adjoint I σ ν) (? φ)))"
proof -
assume hpsafe:"hpsafe (? φ)"
from hpsafe have fsafe:"fsafe φ" by (auto dest: hpsafe.cases)
assume ssafe:"ssafe σ"
fix ν ω
show "?thesis ν ω" using IH[OF fsafe ssafe] by auto
qed
then show ?case by auto
next
case (Fadmit_Geq σ θ1 θ2) then
have TA1:"Tadmit σ θ1" and TA2:"Tadmit σ θ2"
by auto
have "fsafe (Geq θ1 θ2) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (Geq θ1 θ2) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (Geq θ1 θ2)))"
proof -
assume fsafe:"fsafe (Geq θ1 θ2)"
assume ssafe:"ssafe σ"
from fsafe have dsafe1:"dsafe θ1" and dsafe2:"dsafe θ2"
by (auto dest: fsafe.cases)
from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
unfolding ssafe_def by auto
fix ν
show "?thesis ν" using
subst_dterm[OF good_interp TA1 dsafe1 ssafes]
subst_dterm[OF good_interp TA2 dsafe2 ssafes]
by auto
qed
then show ?case by auto
next
case (Fadmit_Prop1 σ args p p') then
have TA:"⋀i. Tadmit σ (args i)"
and some:"SPredicates σ p = Some p'"
and NFA:"NFadmit (λi. Tsubst (args i) σ) p'"
and substSafes:"⋀i. dsafe (Tsubst (args i) σ)"
by auto
have "fsafe ($φ p args) ⟹
ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst ($φ p args) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ($φ p args)))"
proof -
assume fsafe:"fsafe ($φ p args)"
assume ssafe:"ssafe σ"
from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
unfolding ssafe_def by auto
fix ν
from fsafe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)"
using subst_dterm[OF good_interp TA safes ssafes] by auto
have eqs:"⋀i ν'. dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν"
by (auto simp add: IH safes)
let ?sub = "(λ i. Tsubst (args i) σ)"
have freef:"fsafe p'" using ssafe some unfolding ssafe_def by auto
have IH2:"(ν ∈ fml_sem I (FsubstFO p' ?sub)) = (ν ∈ fml_sem (adjointFO I ?sub ν) p')"
using nsubst_fml good_interp NFA freef substSafes
by blast
have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (local.adjoint I σ ν) (args i) ν)"
apply(auto simp add: vec_eq_iff)
subgoal for i
using IH[of i, OF safes[of i]]
by auto
done
show "?thesis ν"
using IH safes eqs apply (auto simp add: IH2 some good_interp)
using some unfolding adjoint_def adjointFO_def by auto
qed
then show "?case" by auto
next
case (Fadmit_Prop2 σ args p)
note TA = Fadmit_Prop2.hyps(1)
and none = Fadmit_Prop2.hyps(2)
have "fsafe (Prop p args) ⟹ ssafe σ ⟹ (⋀ν.(ν ∈ fml_sem I (Fsubst ($φ p args) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ($φ p args)))"
proof -
assume safe:"fsafe (Prop p args)" and ssafe:"ssafe σ"
from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
unfolding ssafe_def by auto
fix ν
from safe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)"
using subst_dterm[OF good_interp TA safes ssafes] by auto
have Ieq:"Predicates I p = Predicates (adjoint I σ ν) p"
using none unfolding adjoint_def by auto
have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (adjoint I σ ν) (args i) ν)"
apply(auto simp add: vec_eq_iff)
subgoal for i using IH[of i, OF safes[of i]] by auto
done
show "?thesis ν" using none IH Ieq vec by auto
qed
then show "?case" by auto
next
case (Fadmit_Not σ φ) then
have IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
by blast
have fsafe:"fsafe (Not φ) ⟹ fsafe φ"
by (auto dest: fsafe.cases)
show ?case using IH[OF fsafe] by auto
next
case (Fadmit_And σ φ ψ) then
have IH1:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
and IH2:"fsafe ψ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst ψ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ψ))"
by (blast)+
have fsafe1:"fsafe (φ && ψ) ⟹ fsafe φ" and fsafe2:"fsafe (φ && ψ) ⟹ fsafe ψ"
by (auto dest: fsafe.cases)
show ?case using IH1[OF fsafe1] IH2[OF fsafe2] by auto
next
case (Fadmit_Exists σ φ x)
then have IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
and FUA:"FUadmit σ φ {Inl x}"
by blast+
have fsafe:"fsafe (Exists x φ) ⟹ fsafe φ"
by (auto dest: fsafe.cases)
have eq:"fsafe (Exists x φ) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (Exists x φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (Exists x φ)))"
proof -
assume fsafe:"fsafe (Exists x φ)"
from fsafe have fsafe':"fsafe φ" by (auto dest: fsafe.cases)
assume ssafe:"ssafe σ"
fix ν
have agree:"⋀r. Vagree ν (repv ν x r) (- {Inl x})"
unfolding Vagree_def by auto
have sem_eq:"⋀r. ((repv ν x r) ∈ fml_sem (local.adjoint I σ (repv ν x r)) φ) =
((repv ν x r) ∈ fml_sem (local.adjoint I σ ν) φ)"
using uadmit_fml_adjoint[OF FUA agree fsafe' ssafe good_interp] by auto
have "(ν ∈ fml_sem I (Fsubst (Exists x φ) σ)) = (∃r. (repv ν x r) ∈ fml_sem I (Fsubst φ σ))"
by auto
moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (local.adjoint I σ (repv ν x r)) φ)"
using IH[OF fsafe' ssafe] by auto
moreover have "... = (∃r. (repv ν x r) ∈ fml_sem (local.adjoint I σ ν) φ)"
using sem_eq by auto
moreover have "... = (ν ∈ fml_sem (adjoint I σ ν) (Exists x φ))"
by auto
ultimately show "(ν ∈ fml_sem I (Fsubst (Exists x φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (Exists x φ))"
by auto
qed
then show ?case by auto
next
case (Fadmit_Diamond σ φ a) then
have PA:"Padmit σ a"
and FUA:"FUadmit σ φ (BVP (Psubst a σ))"
and IH1:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ))"
and IH2:"hpsafe a ⟹ ssafe σ ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (Psubst a σ)) = ((ν, ω) ∈ prog_sem (adjoint I σ ν) a))"
and substSafe:"hpsafe (Psubst a σ)"
by auto
have "fsafe (⟨ a ⟩ φ) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (⟨ a ⟩ φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (⟨ a ⟩ φ)))"
proof -
assume fsafe:"fsafe (⟨ a ⟩ φ)"
assume ssafe:"ssafe σ"
from fsafe have fsafe':"fsafe φ" and hpsafe:"hpsafe a" by (auto dest: fsafe.cases)
fix ν
have agree:"⋀ω. (ν, ω) ∈ prog_sem I (Psubst a σ) ⟹ Vagree ν ω (-BVP(Psubst a σ))"
using bound_effect[OF good_interp, of "(Psubst a σ)" ν, OF substSafe] by auto
have sem_eq:"⋀ω. (ν, ω) ∈ prog_sem I (Psubst a σ) ⟹
(ω ∈ fml_sem (local.adjoint I σ ν) φ) =
(ω ∈ fml_sem (local.adjoint I σ ω) φ)"
using uadmit_fml_adjoint[OF FUA agree fsafe' ssafe good_interp] by auto
have "(ν ∈ fml_sem I (Fsubst (⟨ a ⟩ φ) σ)) = (∃ ω. (ν, ω) ∈ prog_sem I (Psubst a σ) ∧ ω ∈ fml_sem I (Fsubst φ σ))"
by auto
moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjoint I σ ν) a ∧ ω ∈ fml_sem (adjoint I σ ω) φ)"
using IH1[OF fsafe' ssafe] IH2[OF hpsafe ssafe, of ν] by auto
moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem (adjoint I σ ν) a ∧ ω ∈ fml_sem (adjoint I σ ν) φ)"
using sem_eq IH2 hpsafe ssafe by blast
moreover have "... = (ν ∈ fml_sem (adjoint I σ ν) (⟨ a ⟩ φ))"
by auto
ultimately show "?thesis ν" by auto
qed
then show ?case by auto
next
case (Fadmit_Prop1 σ args p p')
have "fsafe(Prop p args) ⟹ ssafe σ ⟹ (⋀ν.(ν ∈ fml_sem I (Fsubst ($φ p args) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) ($φ p args)))"
proof -
assume fsafe:"fsafe (Prop p args)"
and ssafe:"ssafe σ"
from ssafe have ssafes:"(⋀i f'. SFunctions σ i = Some f' ⟹ dfree f')"
"(⋀f f'. SPredicates σ f = Some f' ⟹ fsafe f')"
unfolding ssafe_def by auto
fix ν
note TA = Fadmit_Prop1.hyps(1)
and some = Fadmit_Prop1.hyps(2) and NFA = Fadmit_Prop1.hyps(3)
from fsafe have safes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
have IH:"(⋀ν'. ⋀i. dsafe (args i) ⟹
dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν)"
using subst_dterm[OF good_interp TA safes ssafes] by auto
have eqs:"⋀i ν'. dterm_sem I (Tsubst (args i) σ) ν = dterm_sem (adjoint I σ ν) (args i) ν"
by (auto simp add: IH safes)
let ?sub = "(λ i. Tsubst (args i) σ)"
have subSafe:"(∀ i. dsafe (?sub i))"
by (simp add: safes ssafes tsubst_preserves_safe)
have freef:"fsafe p'" using ssafe some unfolding ssafe_def by auto
have IH2:"(ν ∈ fml_sem I (FsubstFO p' ?sub)) = (ν ∈ fml_sem (adjointFO I ?sub ν) p')"
by (simp add: nsubst_fml [OF good_interp NFA freef subSafe])
have vec:"(χ i. dterm_sem I (Tsubst (args i) σ) ν) = (χ i. dterm_sem (local.adjoint I σ ν) (args i) ν)"
apply(auto simp add: vec_eq_iff)
subgoal for i
using IH[of i, OF safes[of i]]
by auto
done
show "?thesis ν"
using IH safes eqs apply (auto simp add: IH2 some good_interp)
using some unfolding adjoint_def adjointFO_def by auto
qed
next
case (Fadmit_Context1 σ φ C C') then
have FA:"Fadmit σ φ"
and FUA:"FUadmit σ φ UNIV"
and some:"SContexts σ C = Some C'"
and PFA:"PFadmit (λ_. Fsubst φ σ) C'"
and IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
and substSafe:"fsafe(Fsubst φ σ)"
by auto
have "fsafe (InContext C φ) ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (InContext C φ)))"
proof -
assume safe:"fsafe (InContext C φ)"
from safe have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
assume ssafe:"ssafe σ"
fix ν :: "'sz state"
have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
have adj_eq:"⋀ω. fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
using uadmit_fml_adjoint[OF FUA agree fsafe ssafe good_interp] by auto
have eq:"(ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ)"
using adj_eq IH[OF fsafe ssafe] by auto
let ?sub = "(λ_. Fsubst φ σ)"
let ?R1 = "fml_sem I (Fsubst φ σ)"
let ?R2 = "fml_sem (adjoint I σ ν) φ"
have eq':"?R1 = ?R2"
using adj_eq IH[OF fsafe ssafe] by auto
have freef:"fsafe C'" using ssafe some unfolding ssafe_def by auto
have IH2:"(ν ∈ fml_sem I (PFsubst C' ?sub)) = (ν ∈ fml_sem (PFadjoint I ?sub) C')"
using psubst_fml good_interp PFA fsafe substSafe freef by blast
have IH':"(⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ))"
using IH[OF fsafe ssafe] by auto
then have IH:"fml_sem I (Fsubst φ σ) = fml_sem (adjoint I σ ν) φ"
using eq' by blast
have duh:" (λf' _. fml_sem I (case () of () ⇒ Fsubst φ σ)) = (λ x (). fml_sem (local.adjoint I σ ν) φ)"
by (simp add: case_unit_Unity eq' ext)
have extend_PF:"(PFadjoint I ?sub) = (extendc I ?R2)"
unfolding PFadjoint_def using IH apply (simp)
by (metis old.unit.case old.unit.exhaust)
have "(ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem I (PFsubst C' (λ_. Fsubst φ σ)))"
using some by simp
moreover have "... = (ν ∈ fml_sem (PFadjoint I ?sub) C')"
using IH2 by auto
moreover have "... = (ν ∈ fml_sem (extendc I ?R2) C')"
using extend_PF by simp
moreover have "... = (ν ∈ fml_sem (extendc I ?R1) C')"
using eq' by auto
moreover have "... = (ν ∈ Contexts (adjoint I σ ν) C (fml_sem (adjoint I σ ν) φ))"
using some unfolding adjoint_def apply auto
apply (simp add: eq' local.adjoint_def)
by (simp add: eq' local.adjoint_def)
moreover have "... = (ν ∈ fml_sem (adjoint I σ ν) (InContext C φ))"
by auto
ultimately
show "(ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (InContext C φ))"
by blast
qed
then show ?case by auto
next
case (Fadmit_Context2 σ φ C) then
have FA:"Fadmit σ φ"
and FUA:"FUadmit σ φ UNIV"
and none:"SContexts σ C = None"
and IH:"fsafe φ ⟹ ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ))"
by auto
have "fsafe (InContext C φ) ⟹
ssafe σ ⟹ (⋀ν. (ν ∈ fml_sem I (Fsubst (InContext C φ) σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) (InContext C φ)))"
proof -
assume safe:"fsafe (InContext C φ)"
then have fsafe:"fsafe φ" by (auto dest: fsafe.cases)
assume ssafe:"ssafe σ"
fix ν
have Ieq:" Contexts (local.adjoint I σ ν) C = Contexts I C"
using none unfolding adjoint_def by auto
have IH':"⋀ν. (ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (local.adjoint I σ ν) φ)"
using IH[OF fsafe ssafe] by auto
have agree:"⋀ω. Vagree ν ω (-UNIV)" unfolding Vagree_def by auto
have adj_eq:"⋀ω. fml_sem (adjoint I σ ν) φ = fml_sem (adjoint I σ ω) φ"
using uadmit_fml_adjoint[OF FUA agree fsafe ssafe good_interp] by auto
then have sem:"fml_sem I (Fsubst φ σ) = fml_sem (local.adjoint I σ ν) φ"
using IH' agree adj_eq by auto
show "?thesis ν" using none Ieq sem by auto
qed
then show ?case by auto
qed
lemma subst_fml:
fixes I::"('sf, 'sc, 'sz) interp" and ν::"'sz state"
assumes good_interp:"is_interp I"
assumes Fadmit:"Fadmit σ φ"
assumes fsafe:"fsafe φ"
assumes ssafe:"ssafe σ"
shows "(ν ∈ fml_sem I (Fsubst φ σ)) = (ν ∈ fml_sem (adjoint I σ ν) φ)"
using subst_fml_hp[OF good_interp] Fadmit fsafe ssafe by blast
lemma subst_fml_valid:
fixes I::"('sf, 'sc, 'sz) interp" and ν::"'sz state"
assumes Fadmit:"Fadmit σ φ"
assumes fsafe:"fsafe φ"
assumes ssafe:"ssafe σ"
assumes valid:"valid φ"
shows "valid (Fsubst φ σ)"
proof -
have sub_sem:"⋀I ν. is_interp I ⟹ ν ∈ fml_sem I (Fsubst φ σ)"
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good_interp:"is_interp I"
have good_adj:"is_interp (adjoint I σ ν)"
apply(rule adjoint_safe[OF good_interp])
using ssafe unfolding ssafe_def by auto
have φsem:"ν ∈ fml_sem (adjoint I σ ν) φ" using valid using good_adj unfolding valid_def by blast
then show "?thesis I ν"
using subst_fml[OF good_interp Fadmit fsafe ssafe]
by auto
qed
then show ?thesis unfolding valid_def by blast
qed
lemma subst_sequent:
fixes I::"('sf, 'sc, 'sz) interp" and ν::"'sz state"
assumes good_interp:"is_interp I"
assumes Sadmit:"Sadmit σ (Γ,Δ)"
assumes Ssafe:"Ssafe (Γ,Δ)"
assumes ssafe:"ssafe σ"
shows "(ν ∈ seq_sem I (Ssubst (Γ,Δ) σ)) = (ν ∈ seq_sem (adjoint I σ ν) (Γ,Δ))"
proof -
let ?f = "(seq2fml (Γ, Δ))"
have subst_eqG:"Fsubst (foldr (&&) Γ TT) σ = foldr (&&) (map (λφ. Fsubst φ σ) Γ) TT"
by(induction Γ, auto simp add: TT_def)
have subst_eqD:"Fsubst (foldr (||) Δ FF) σ = foldr (||) (map (λφ. Fsubst φ σ) Δ) FF"
by(induction Δ, auto simp add: FF_def Or_def)
have subst_eq:"Fsubst ?f σ = (seq2fml (Ssubst (Γ, Δ) σ))"
using subst_eqG subst_eqD
by (auto simp add: Implies_def Or_def)
have fsafeG:"fsafe (foldr (&&) Γ TT)"
using Ssafe apply(induction Γ, auto simp add: Ssafe_def TT_def)
by fastforce
have fsafeD:"fsafe (foldr (||) Δ FF)"
using Ssafe Or_def apply(induction Δ, auto simp add: Ssafe_def FF_def Or_def)
by fastforce
have fsafe:"fsafe ?f"
using fsafeD fsafeG by (auto simp add: Implies_def Or_def)
have FadmitG:"Fadmit σ (foldr (&&) Γ TT)"
using Sadmit Or_def apply(induction Γ, auto simp add: Sadmit_def TT_def Or_def)
by fastforce
have FadmitD:"Fadmit σ (foldr (||) Δ FF)"
using Sadmit Or_def apply(induction Δ, auto simp add: Sadmit_def FF_def Or_def)
by fastforce
have Fadmit:"Fadmit σ ?f"
using FadmitG FadmitD unfolding Implies_def
by (simp add: Implies_def Or_def)
have "(ν ∈ fml_sem I (Fsubst ?f σ))
=(ν ∈ fml_sem (adjoint I σ ν) (seq2fml (Γ, Δ)))"
using subst_fml[OF good_interp Fadmit fsafe ssafe]
by auto
then show ?thesis
using subst_eq by auto
qed
subsection ‹Soundness of substitution rule›
theorem subst_rule:
assumes sound:"sound R"
assumes Radmit:"Radmit σ R"
assumes FVS:"FVS σ = {}"
assumes Rsafe:"Rsafe R"
assumes ssafe:"ssafe σ"
shows "sound (Rsubst R σ)"
proof -
obtain SG and C where Rdef:"R = (SG,C)" by (cases R, auto)
obtain SG' and C' where Rdef':"Rsubst R σ = (SG',C')" by (cases R, auto)
obtain ΓC and ΔC where Cdef:"C = (ΓC, ΔC)" by (cases C, auto)
obtain ΓC' and ΔC' where C'def:"C' = (ΓC', ΔC')" by (cases C', auto)
have CC':"(Ssubst (ΓC, ΔC) σ) = (ΓC', ΔC')"
using Rdef Rdef' Cdef C'def by auto
have "⋀I ν. is_interp I ⟹ (⋀Γ Δ ω . List.member SG' (Γ, Δ) ⟹ ω ∈ seq_sem I (Γ, Δ)) ⟹ ν ∈ seq_sem I C'"
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good_interp:"is_interp I"
assume prems:"(⋀Γ Δ ω. List.member SG' (Γ, Δ) ⟹ ω ∈ seq_sem I (Γ, Δ))"
have good_interp':"⋀ω. is_interp (adjoint I σ ω)"
using adjoint_safe[OF good_interp ] ssafe[unfolded ssafe_def] by auto
have sound:"⋀ω. (⋀φ ν . List.member SG φ ⟹ ν ∈ seq_sem (adjoint I σ ω) φ) ⟹ ω ∈ seq_sem (adjoint I σ ω) (ΓC, ΔC)"
using soundD_memv[of SG C] sound good_interp' Rdef Cdef by auto
have SadmitC:"Sadmit σ (ΓC, ΔC)"
using Radmit unfolding Radmit_def Rdef Cdef by auto
have SsafeC:"Ssafe (ΓC, ΔC)"
using Rsafe unfolding Rsafe_def Rdef Cdef by auto
have seq_sem:"ν ∈ seq_sem (adjoint I σ ν) (ΓC, ΔC)"
proof(rule sound)
fix S :: "('sf,'sc,'sz) sequent" and ν'
assume mem:"List.member SG S"
obtain ΓS ΔS where Sdef:"S = (ΓS, ΔS)" by (cases S, auto)
from mem obtain di where di:"di < length SG ∧ SG ! di = S"
by (meson in_set_conv_nth in_set_member)
have SadmitS:"Sadmit σ (ΓS, ΔS)"
using Rdef Sdef di Radmit Radmit_def by auto
have SsafeS:"Ssafe (ΓS, ΔS)"
using Rsafe unfolding Rsafe_def Rdef Cdef using Sdef mem di by auto
have map_mem:"⋀f L x. List.member L x ⟹ List.member (map f L) (f x)"
subgoal for f L x
by (induction L, auto simp add: member_rec)
done
let ?S' = "(Ssubst (ΓS, ΔS) σ)"
have eq:"Ssubst S σ = (map (λφ. Fsubst φ σ) ΓS, map (λφ. Fsubst φ σ) ΔS)"
using Sdef by auto
from Sdef have mem':"List.member SG' (fst ?S', snd ?S')"
using mem Rdef Rdef' eq map_mem[of SG S "(λx. Ssubst x σ)"] by auto
have "ν' ∈ seq_sem I (fst ?S', snd ?S')" by (rule prems[OF mem', of ν'])
then have "ν' ∈ seq_sem (adjoint I σ ν') S"
using subst_sequent[OF good_interp SadmitS SsafeS ssafe, of ν']
Sdef by auto
have VA:"Vagree ν ν' (FVS σ)" using FVS unfolding Vagree_def by auto
show "ν' ∈ seq_sem (local.adjoint I σ ν) S"
using adjoint_consequence VA ssafe[unfolded ssafe_def]
by (metis ‹ν' ∈ seq_sem (local.adjoint I σ ν') S› dfree_is_dsafe)
qed
have "ν ∈ seq_sem I (ΓC', ΔC')"
using subst_sequent[OF good_interp SadmitC SsafeC ssafe, of ν] seq_sem Cdef C'def CC'
by auto
then show "ν ∈ seq_sem I C'" using C'def by auto
qed
then show ?thesis
apply(rule soundI_memv')
using Rdef' by auto
qed
end end
Theory Uniform_Renaming
theory "Uniform_Renaming"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Frechet_Correctness"
"Static_Semantics"
"Coincidence"
"Bound_Effect"
begin context ids begin
section ‹Uniform and Bound Renaming›
text ‹Definitions and soundness proofs for the renaming rules Uniform Renaming and Bound Renaming.
Renaming in dL swaps the names of two variables x and y, as in the swap operator of Nominal Logic.
›
fun swap ::"'sz ⇒ 'sz ⇒ 'sz ⇒ 'sz"
where "swap x y z = (if z = x then y else if z = y then x else z)"
subsection ‹Uniform Renaming Definitions›
primrec TUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sz) trm ⇒ ('sf, 'sz) trm"
where
"TUrename x y (Var z) = Var (swap x y z)"
| "TUrename x y (DiffVar z) = DiffVar (swap x y z)"
| "TUrename x y (Const r) = (Const r)"
| "TUrename x y (Function f args) = Function f (λi. TUrename x y (args i))"
| "TUrename x y (Plus θ1 θ2) = Plus (TUrename x y θ1) (TUrename x y θ2)"
| "TUrename x y (Times θ1 θ2) = Times (TUrename x y θ1) (TUrename x y θ2)"
| "TUrename x y (Differential θ) = Differential (TUrename x y θ)"
primrec OUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sz) ODE ⇒ ('sf, 'sz) ODE"
where
"OUrename x y (OVar c) = undefined"
| "OUrename x y (OSing z θ) = OSing (swap x y z) (TUrename x y θ)"
| "OUrename x y (OProd ODE1 ODE2) = OProd (OUrename x y ODE1) (OUrename x y ODE2)"
inductive ORadmit :: "('sf, 'sz) ODE ⇒ bool"
where
ORadmit_Sing:"ORadmit (OSing x θ)"
| ORadmit_Prod:"ORadmit ODE1 ⟹ ORadmit ODE2 ⟹ ORadmit (OProd ODE1 ODE2)"
primrec PUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sc, 'sz) hp ⇒ ('sf, 'sc, 'sz) hp"
and FUrename :: "'sz ⇒ 'sz ⇒ ('sf, 'sc, 'sz) formula ⇒ ('sf, 'sc, 'sz) formula"
where
"PUrename x y (Pvar a) = undefined"
| "PUrename x y (Assign z θ) = Assign (swap x y z) (TUrename x y θ)"
| "PUrename x y (DiffAssign z θ) = DiffAssign (swap x y z) (TUrename x y θ)"
| "PUrename x y (Test φ) = Test (FUrename x y φ)"
| "PUrename x y (EvolveODE ODE φ) = EvolveODE (OUrename x y ODE) (FUrename x y φ)"
| "PUrename x y (Choice a b) = Choice (PUrename x y a) (PUrename x y b)"
| "PUrename x y (Sequence a b) = Sequence (PUrename x y a) (PUrename x y b)"
| "PUrename x y (Loop a) = Loop (PUrename x y a)"
| "FUrename x y (Geq θ1 θ2) = Geq (TUrename x y θ1) (TUrename x y θ2)"
| "FUrename x y (Prop p args) = Prop p (λi. TUrename x y (args i))"
| "FUrename x y (Not φ) = Not (FUrename x y φ)"
| "FUrename x y (And φ ψ) = And (FUrename x y φ) (FUrename x y ψ)"
| "FUrename x y (Exists z φ) = Exists (swap x y z) (FUrename x y φ)"
| "FUrename x y (Diamond α φ) = Diamond (PUrename x y α) (FUrename x y φ)"
| "FUrename x y (InContext C φ) = undefined"
subsection ‹Uniform Renaming Admissibility›
inductive PRadmit :: "('sf, 'sc, 'sz) hp ⇒ bool"
and FRadmit ::"('sf, 'sc, 'sz) formula ⇒ bool"
where
PRadmit_Assign:"PRadmit (Assign x θ)"
| PRadmit_DiffAssign:"PRadmit (DiffAssign x θ)"
| PRadmit_Test:"FRadmit φ ⟹ PRadmit (Test φ)"
| PRadmit_EvolveODE:"ORadmit ODE ⟹ FRadmit φ ⟹ PRadmit (EvolveODE ODE φ)"
| PRadmit_Choice:"PRadmit a ⟹ PRadmit b ⟹ PRadmit (Choice a b)"
| PRadmit_Sequence:"PRadmit a ⟹ PRadmit b ⟹ PRadmit (Sequence a b)"
| PRadmit_Loop:"PRadmit a ⟹ PRadmit (Loop a)"
| FRadmit_Geq:"FRadmit (Geq θ1 θ2)"
| FRadmit_Prop:"FRadmit (Prop p args)"
| FRadmit_Not:"FRadmit φ ⟹ FRadmit (Not φ)"
| FRadmit_And:"FRadmit φ ⟹ FRadmit ψ ⟹ FRadmit (And φ ψ)"
| FRadmit_Exists:"FRadmit φ ⟹ FRadmit (Exists x φ)"
| FRadmit_Diamond:"PRadmit α ⟹ FRadmit φ ⟹ FRadmit (Diamond α φ)"
inductive_simps
FRadmit_box_simps[simp]: "FRadmit (Box a f)"
and PRadmit_box_simps[simp]: "PRadmit (Assign x e)"
definition RSadj :: "'sz ⇒ 'sz ⇒ 'sz simple_state ⇒ 'sz simple_state"
where "RSadj x y ν = (χ z. ν $ (swap x y z))"
definition Radj :: "'sz ⇒ 'sz ⇒ 'sz state ⇒ 'sz state"
where "Radj x y ν = (RSadj x y (fst ν), RSadj x y (snd ν))"
lemma SUren: "sterm_sem I (TUrename x y θ) ν = sterm_sem I θ (RSadj x y ν)"
by (induction θ, auto simp add: RSadj_def)
lemma ren_preserves_dfree:"dfree θ ⟹ dfree (TUrename x y θ)"
by(induction rule: dfree.induct, auto intro: dfree.intros)
subsection ‹Uniform Renaming Soundness Proof and Lemmas›
lemma TUren_frechet:
assumes good_interp:"is_interp I"
shows "dfree θ ⟹ frechet I (TUrename x y θ) ν ν' = frechet I θ (RSadj x y ν) (RSadj x y ν')"
proof (induction rule: dfree.induct)
case (dfree_Var i)
then show ?case
unfolding RSadj_def apply auto
subgoal by (metis vec_lambda_eta)
subgoal
proof (auto simp add: axis_def)
assume yx:"y ≠ x"
have a:"(χ z. ν' $ (if z = x then y else if z = y then x else z)) $ y = ν' $ x"
by simp
show "ν' ∙ (χ i. if i = x then 1 else 0)
= (χ z. ν' $ (if z = x then y else if z = y then x else z)) ∙ (χ i. if i = y then 1 else 0)"
by (metis (no_types) a axis_def inner_axis)
qed
subgoal
proof -
have "⋀v s. v ∙ (χ sa. if sa = (s::'sz) then 1 else 0) = v $ s"
subgoal for v s
using inner_axis[of v s 1]
by (auto simp add: axis_def)
done
then show ?thesis
by (auto simp add: axis_def)
qed
subgoal
proof -
assume a1: "i ≠ y"
assume a2: "i ≠ x"
have "⋀v s. v ∙ (χ sa. if sa = (s::'sz) then 1 else 0) = v $ s"
by (metis (no_types) inner_axis axis_def inner_prod_eq)
then show ?thesis
using a2 a1 by (auto simp add: axis_def)
qed
done
qed (auto simp add: SUren good_interp is_interp_def)
lemma RSadj_fst:"RSadj x y (fst ν) = fst (Radj x y ν)"
unfolding RSadj_def Radj_def by auto
lemma RSadj_snd:"RSadj x y (snd ν) = snd (Radj x y ν)"
unfolding RSadj_def Radj_def by auto
lemma TUren:
assumes good_interp:"is_interp I"
shows "dsafe θ ⟹ dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν)"
proof (induction rule: dsafe.induct)
case (dsafe_Diff θ)
assume free:"dfree θ"
show ?case
apply (auto simp add: directional_derivative_def)
using TUren_frechet[OF good_interp free, of x y "fst ν" "snd ν"]
by (auto simp add: RSadj_fst RSadj_snd)
qed (auto simp add: Radj_def RSadj_def)
lemma adj_sum:"RSadj x y (ν1 + ν2) = (RSadj x y ν1) + (RSadj x y ν2)"
unfolding RSadj_def apply auto apply (rule vec_extensionality)
subgoal for i
apply (cases "i = x")
apply (cases "i = y")
by auto
done
lemma OUren: "ORadmit ODE ⟹ ODE_sem I (OUrename x y ODE) ν = RSadj x y (ODE_sem I ODE (RSadj x y ν))"
proof (induction rule: ORadmit.induct)
case (ORadmit_Prod ODE1 ODE2)
then show ?case
using adj_sum by auto
next
case (ORadmit_Sing z θ)
then show ?case
by (rule vec_extensionality | auto simp add: SUren RSadj_def)+
qed
lemma state_eq:
fixes ν ν' :: "'sz state"
shows "(⋀i. (fst ν) $ i = (fst ν') $ i) ⟹ (⋀i. (snd ν) $ i = (snd ν') $ i) ⟹ ν = ν'"
apply (cases "ν", cases "ν'", auto)
by(rule vec_extensionality, auto)+
lemma Radj_repv1:
fixes x y z ::"'sz"
shows "(Radj x y (repv ν y r)) = repv (Radj x y ν) x r"
apply(rule state_eq)
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
done
lemma Radj_repv2:
fixes x y z ::"'sz"
shows "(Radj x y (repv ν x r)) = repv (Radj x y ν) y r"
apply(rule state_eq)
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
done
lemma Radj_repv3:
fixes x y z ::"'sz"
assumes zx:"z ≠ x" and zy:"z ≠ y"
shows "(Radj x y (repv ν z r)) = repv (Radj x y ν) z r"
apply(rule state_eq)
subgoal for i
apply(cases "i = x") apply (cases "i = y")
using zx zy unfolding Radj_def RSadj_def by auto
subgoal for i
apply(cases "i = x") apply (cases "i = y")
using zx zy unfolding Radj_def RSadj_def by auto
done
lemma Radj_repd1:
fixes x y z ::"'sz"
shows "(Radj x y (repd ν y r)) = repd (Radj x y ν) x r"
apply(rule state_eq)
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
done
lemma Radj_repd2:
fixes x y z ::"'sz"
shows "(Radj x y (repd ν x r)) = repd (Radj x y ν) y r"
apply(rule state_eq)
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
subgoal for i
apply(cases "i = x") apply (cases "i = y")
unfolding Radj_def RSadj_def by auto
done
lemma Radj_repd3:
fixes x y z ::"'sz"
assumes zx:"z ≠ x" and zy:"z ≠ y"
shows "(Radj x y (repd ν z r)) = repd (Radj x y ν) z r"
apply(rule state_eq)
subgoal for i
apply(cases "i = x") apply (cases "i = y")
using zx zy unfolding Radj_def RSadj_def by auto
subgoal for i
apply(cases "i = x") apply (cases "i = y")
using zx zy unfolding Radj_def RSadj_def by auto
done
lemma Radj_eq_iff:"(a = b) = ((Radj x y a) = (Radj x y b))"
unfolding Radj_def RSadj_def apply auto
apply (rule state_eq)
apply smt+
done
lemma RSadj_cancel:"RSadj x y (RSadj x y ν) = ν"
unfolding RSadj_def apply auto
apply(rule vec_extensionality)
by(auto)
lemma Radj_cancel:"Radj x y (Radj x y ν) = ν"
unfolding Radj_def RSadj_def apply auto
apply(rule state_eq)
subgoal for i by(cases "i = x", cases "i = y", auto)
subgoal for i by(cases "i = x", cases "i = y", auto)
done
lemma OUrename_preserves_ODE_vars:"ORadmit ODE ⟹ {z. (swap x y z) ∈ ODE_vars I ODE} = ODE_vars I (OUrename x y ODE)"
apply(induction rule: ORadmit.induct)
subgoal for xa θ by auto
subgoal for ODE1 ODE2
proof -
assume IH1:"{z. swap x y z ∈ ODE_vars I ODE1} = ODE_vars I (OUrename x y ODE1)"
assume IH2:"{z. swap x y z ∈ ODE_vars I ODE2} = ODE_vars I (OUrename x y ODE2)"
have "{z. swap x y z ∈ ODE_vars I (OProd ODE1 ODE2)} =
{z. swap x y z ∈ (ODE_vars I ODE1 ∪ ODE_vars I ODE2)}" by auto
moreover have "... = {z. swap x y z ∈ (ODE_vars I ODE1)} ∪ {z. swap x y z ∈ (ODE_vars I ODE2)}" by auto
moreover have "... = ODE_vars I (OUrename x y ODE1) ∪ ODE_vars I (OUrename x y ODE2)" using IH1 IH2 by auto
moreover have "... = ODE_vars I (OUrename x y (OProd ODE1 ODE2))" by auto
ultimately show "{z. swap x y z ∈ ODE_vars I (OProd ODE1 ODE2)} = ODE_vars I (OUrename x y (OProd ODE1 ODE2))"
by blast
qed
done
lemma ren_proj:"(RSadj x y a) $ z = a $ (swap x y z)"
unfolding RSadj_def by simp
lemma swap_cancel:"swap x y (swap x y z) = z"
by auto
lemma mkv_lemma:
assumes ORA:"ORadmit ODE"
shows "Radj x y (mk_v I (OUrename x y ODE) (a, b) c) = mk_v I ODE (RSadj x y a, RSadj x y b) (RSadj x y c)"
proof -
have inner1:"(mk_v I (OUrename x y ODE) (a, b) c) = ((χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then c else a) $ i), (χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then ODE_sem I (OUrename x y ODE) c else b) $ i))"
using mk_v_concrete[of I "OUrename x y ODE" "(a,b)" c] by auto
have inner2:"(((χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then c else a) $ i), (χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then ODE_sem I (OUrename x y ODE) c else b) $ i)))
= (((χ i. (if (swap x y i) ∈ ODE_vars I ODE then c else a) $ i), (χ i. (if (swap x y i) ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ i)))"
by (force simp: OUrename_preserves_ODE_vars[OF ORA, symmetric])
have "Radj x y (mk_v I (OUrename x y ODE) (a, b) c) =
Radj x y (((χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then c else a) $ i), (χ i. (if i ∈ ODE_vars I (OUrename x y ODE) then ODE_sem I (OUrename x y ODE) c else b) $ i)))"
using inner1 by auto
moreover have "... = Radj x y (((χ i. (if (swap x y i) ∈ ODE_vars I ODE then c else a) $ i),
(χ i. (if (swap x y i) ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ i)))"
using inner2 by auto
moreover have "... = (((χ i. (if (swap x y (swap x y i)) ∈ ODE_vars I ODE then c else a) $ (swap x y i))),
(χ i. (if (swap x y (swap x y i)) ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ (swap x y i)))"
unfolding Radj_def RSadj_def by auto
moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then c else a) $ (swap x y i))),
(χ i. (if i ∈ ODE_vars I ODE then ODE_sem I (OUrename x y ODE) c else b) $ (swap x y i)))"
using swap_cancel by auto
moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then RSadj x y c else RSadj x y a) $ i)),
(χ i. (if i ∈ ODE_vars I ODE then RSadj x y (ODE_sem I (OUrename x y ODE) c) else RSadj x y b) $ i))"
by(auto simp add: ren_proj)
moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then RSadj x y c else RSadj x y a) $ i)),
(χ i. (if i ∈ ODE_vars I ODE then RSadj x y (RSadj x y (ODE_sem I ODE (RSadj x y c))) else RSadj x y b) $ i))"
using OUren[OF ORA, of I x y c] by auto
moreover have "... = (((χ i. (if i ∈ ODE_vars I ODE then RSadj x y c else RSadj x y a) $ i)),
(χ i. (if i ∈ ODE_vars I ODE then (ODE_sem I ODE (RSadj x y c)) else RSadj x y b) $ i))"
by(auto simp add: RSadj_cancel)
moreover have "... = mk_v I ODE (RSadj x y a, RSadj x y b) (RSadj x y c)"
using mk_v_concrete[of I "ODE" "(RSadj x y a, RSadj x y b)" "RSadj x y c"]
by auto
ultimately show ?thesis by auto
qed
lemma sol_lemma:
assumes ORA:"ORadmit ODE"
assumes t:"0 ≤ t"
assumes fml:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)"
assumes sol:"(sol solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t} {xa. mk_v I (OUrename x y ODE) (sol 0, b) xa ∈ fml_sem I (FUrename x y φ)}"
shows "((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I ODE)) {0..t} {xa. mk_v I ODE (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I φ}"
apply(unfold solves_ode_def)
apply(rule conjI)
defer
subgoal
apply auto
proof -
fix s
assume t:"0 ≤ s" "s ≤ t"
have ivl:"s ∈ {0..t}" using t by auto
have "mk_v I (OUrename x y ODE) (sol 0,b) (sol s) ∈ fml_sem I (FUrename x y φ)"
using solves_odeD(2)[OF sol ivl] by auto
then have "Radj x y (mk_v I (OUrename x y ODE) (sol 0, b) (sol s)) ∈ fml_sem I φ"
using fml[of "mk_v I (OUrename x y ODE) (sol 0, b) (sol s)"] by auto
then show "mk_v I ODE (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol s)) ∈ fml_sem I φ"
using mkv_lemma[OF ORA, of x y I "sol 0" b "sol s"] by auto
qed
apply (unfold has_vderiv_on_def has_vector_derivative_def)
proof -
have "⋀s. s∈{0..t} ⟹ ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩R ODE_sem I ODE (RSadj x y (sol s)))) (at s within {0..t})"
proof -
fix s
assume s:"s ∈{0..t}"
let ?g = "RSadj x y"
let ?g' = "RSadj x y"
let ?f = "sol"
let ?f' = "(λt'. t' *⇩R ODE_sem I (OUrename x y ODE) (sol s))"
let ?h = "?g ∘ ?f"
have fun_eq:"(λt'. t' *⇩R ODE_sem I (OUrename x y ODE) (sol s)) = (λt'. t' *⇩R (RSadj x y (ODE_sem I ODE (RSadj x y (sol s)))))"
apply(rule ext)
using OUren[OF ORA, of I x y] by simp
have fun_eq1:"(λν. (χ i. RSadj x y ν $ i)) = RSadj x y"
by(rule ext, rule vec_extensionality, simp)
have "s ∈ {0..t} ⟹ (sol has_derivative (λt'. t' *⇩R ODE_sem I (OUrename x y ODE) (sol s))) (at s within {0..t})"
using solves_odeD(1)[OF sol] unfolding has_vderiv_on_def has_vector_derivative_def by auto
then have fderiv:"s ∈ {0..t} ⟹ (?f has_derivative ?f') (at s within {0..t})"
using fun_eq by auto
have "((λν. (χ i. RSadj x y ν $ i)) has_derivative (λν'. (χ i . RSadj x y ν' $ i))) (at (?f s) within ?f ` {0..t})"
apply(rule has_derivative_vec)
apply(auto simp add: RSadj_def intro:derivative_eq_intros)
by (simp add: has_derivative_at_withinI has_derivative_proj')+
then have gderiv:"(RSadj x y has_derivative (RSadj x y)) (at (?f s) within ?f ` {0..t})"
using fun_eq1 by auto
have hderiv:"(?h has_derivative (?g' ∘ ?f')) (at s within {0..t})"
by (rule diff_chain_within[OF fderiv gderiv], rule s)
have heq:"(λt. RSadj x y (sol t)) = ?h"
unfolding comp_def by simp
have RSadj_scale:"⋀c a. RSadj x y (c *⇩R RSadj x y a) = c *⇩R a"
subgoal for c a
unfolding RSadj_def
apply auto
apply(rule vec_extensionality)
by(auto)
done
have heq':"(λxb. xb *⇩R ODE_sem I ODE (RSadj x y (sol s))) = (?g' ∘ ?f')"
unfolding comp_def apply(rule ext) using OUren[OF ORA, of I x y "sol s"]
apply auto
subgoal for c
using RSadj_scale[of c "ODE_sem I ODE (RSadj x y (sol s))"] by auto
done
show "((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩R ODE_sem I ODE (RSadj x y (sol s)))) (at s within {0..t})"
using heq heq' hderiv by auto
qed
then show "∀xa∈{0..t}. ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩R ODE_sem I ODE (RSadj x y (sol xa)))) (at xa within {0..t})"
by auto
qed
lemma sol_lemma2:
assumes ORA:"ORadmit ODE"
assumes t:"0 ≤ t"
assumes fml:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)"
assumes sol:"(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I φ}"
shows "((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t}
{xa. mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I (FUrename x y φ)}"
apply(unfold solves_ode_def)
apply(rule conjI)
defer
subgoal
apply auto
proof -
fix s
assume t:"0 ≤ s" "s ≤ t"
have ivl:"s ∈ {0..t}" using t by auto
have "mk_v I ODE (sol 0,b) (sol s) ∈ fml_sem I φ"
using solves_odeD(2)[OF sol ivl] by auto
then have "Radj x y (mk_v I ODE (sol 0, b) (sol s)) ∈ fml_sem I (FUrename x y φ)"
using Radj_cancel[of x y "(mk_v I ODE (sol 0, b) (sol s))"]
by (simp add: fml)
then show " mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol s)) ∈ fml_sem I (FUrename x y φ)"
using mkv_lemma[OF ORA, of x y I "RSadj x y (sol 0)" "RSadj x y b" "RSadj x y (sol s)"]
by (simp add: RSadj_cancel ‹mk_v I ODE (sol 0, b) (sol s) ∈ fml_sem I φ› fml)
qed
apply (unfold has_vderiv_on_def has_vector_derivative_def)
proof -
have "⋀s. s∈{0..t} ⟹ ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩R ODE_sem I (OUrename x y ODE) (RSadj x y (sol s)))) (at s within {0..t})"
proof -
fix s
assume s:"s ∈{0..t}"
let ?g = "RSadj x y"
let ?g' = "RSadj x y"
let ?f = "sol"
let ?f' = "(λxb. xb *⇩R RSadj x y (ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))))"
let ?h = "?g ∘ ?f"
have fun_eq:"(λt'. t' *⇩R ODE_sem I ODE (sol s)) = (λxb. xb *⇩R RSadj x y (ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))))"
apply(rule ext)
using OUren[OF ORA, of I x y, of "RSadj x y (sol s)"] RSadj_cancel by simp
have fun_eq1:"(λν. (χ i. RSadj x y ν $ i)) = RSadj x y"
by(rule ext, rule vec_extensionality, simp)
have "s ∈ {0..t} ⟹ (sol has_derivative (λt'. t' *⇩R ODE_sem I ODE (sol s))) (at s within {0..t})"
using solves_odeD(1)[OF sol] unfolding has_vderiv_on_def has_vector_derivative_def by auto
then have fderiv:"s ∈ {0..t} ⟹ (?f has_derivative ?f') (at s within {0..t})"
using fun_eq by auto
have "((λν. (χ i. RSadj x y ν $ i)) has_derivative (λν'. (χ i . RSadj x y ν' $ i))) (at (?f s) within ?f ` {0..t})"
apply(rule has_derivative_vec)
apply(auto simp add: RSadj_def intro:derivative_eq_intros)
by (simp add: has_derivative_at_withinI has_derivative_proj')+
then have gderiv:"(RSadj x y has_derivative (RSadj x y)) (at (?f s) within ?f ` {0..t})"
using fun_eq1 by auto
have hderiv:"(?h has_derivative (?g' ∘ ?f')) (at s within {0..t})"
by (rule diff_chain_within[OF fderiv gderiv], rule s)
have heq:"(λt. RSadj x y (sol t)) = ?h"
unfolding comp_def by simp
have RSadj_scale:"⋀c a. RSadj x y (c *⇩R RSadj x y a) = c *⇩R a"
subgoal for c a
unfolding RSadj_def
apply auto
apply(rule vec_extensionality)
by(auto)
done
have heq':"(λxb. xb *⇩R ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))) = (?g' ∘ ?f')"
unfolding comp_def apply(rule ext) using OUren[OF ORA, of I x y "RSadj x y (sol s)"]
apply auto
subgoal for c
using RSadj_scale[of c "ODE_sem I (OUrename x y ODE) (RSadj x y (sol s))"] RSadj_cancel[of x y "sol s"]
RSadj_cancel[of x y "ODE_sem I ODE (sol s)"] by auto
done
show "((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩R ODE_sem I (OUrename x y ODE) (RSadj x y (sol s)))) (at s within {0..t})"
using heq heq' hderiv by auto
qed
then show "∀xa∈{0..t}. ((λt. RSadj x y (sol t)) has_derivative (λxb. xb *⇩R ODE_sem I (OUrename x y ODE) (RSadj x y (sol xa)))) (at xa within {0..t})"
by blast
qed
lemma PUren_FUren:
assumes good_interp:"is_interp I"
shows
"(PRadmit α ⟶ hpsafe α ⟶ (∀ ν ω. (ν, ω) ∈ prog_sem I (PUrename x y α) ⟷ (Radj x y ν, Radj x y ω) ∈ prog_sem I α))
∧ (FRadmit φ ⟶ fsafe φ ⟶ (∀ ν. ν ∈ fml_sem I (FUrename x y φ) ⟷ (Radj x y ν) ∈ fml_sem I φ))"
proof(induction rule: PRadmit_FRadmit.induct)
case (FRadmit_Geq θ1 θ2)
then show ?case using TUren[OF good_interp] by auto
next
case (FRadmit_Exists φ z) then have
FRA:"FRadmit φ"
and IH:"fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
by auto
have "fsafe (Exists z φ) ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ)))"
apply (cases "z = x")
subgoal for ν
proof -
assume fsafe:"fsafe (Exists z φ)"
assume zx:"z = x"
from fsafe have fsafe':"fsafe φ" by auto
have IH':"(⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
by (rule IH[OF fsafe'])
have "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (ν ∈ fml_sem I (Exists y (FUrename x y φ)))" using zx by auto
moreover have "... = (∃r. (repv ν y r) ∈ fml_sem I (FUrename x y φ))" by auto
moreover have "... = (∃r. (Radj x y (repv ν y r)) ∈ fml_sem I φ)" using IH' by auto
moreover have "... = (∃r. (repv (Radj x y ν) x r) ∈ fml_sem I φ)" using Radj_repv1[of x y ν] by auto
moreover have "... = (Radj x y ν ∈ fml_sem I (Exists z φ))" using zx by auto
ultimately
show "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ))"
by auto
qed
apply (cases "z = y")
subgoal for ν
proof -
assume fsafe:"fsafe (Exists z φ)"
assume zx:"z = y"
from fsafe have fsafe':"fsafe φ" by auto
have IH':"(⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
by (rule IH[OF fsafe'])
have "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (ν ∈ fml_sem I (Exists x (FUrename x y φ)))" using zx by auto
moreover have "... = (∃r. (repv ν x r) ∈ fml_sem I (FUrename x y φ))" by auto
moreover have "... = (∃r. (Radj x y (repv ν x r)) ∈ fml_sem I φ)" using IH' by auto
moreover have "... = (∃r. (repv (Radj x y ν) y r) ∈ fml_sem I φ)" using Radj_repv2[of x y ν] by auto
moreover have "... = (Radj x y ν ∈ fml_sem I (Exists z φ))" using zx by auto
ultimately
show "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ))"
by auto
qed
subgoal for ν
proof -
assume fsafe:"fsafe (Exists z φ)"
assume zx:"z ≠ x" and zy:"z ≠ y"
from fsafe have fsafe':"fsafe φ" by auto
have IH':"(⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
by (rule IH[OF fsafe'])
have "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (ν ∈ fml_sem I (Exists z (FUrename x y φ)))" using zx zy by auto
moreover have "... = (∃r. (repv ν z r) ∈ fml_sem I (FUrename x y φ))" by auto
moreover have "... = (∃r. (Radj x y (repv ν z r)) ∈ fml_sem I φ)" using IH' by auto
moreover have "... = (∃r. (repv (Radj x y ν) z r) ∈ fml_sem I φ)" using Radj_repv3[of z x y ν, OF zx zy] by auto
moreover have "... = (Radj x y ν ∈ fml_sem I (Exists z φ))" using zx by auto
ultimately
show "(ν ∈ fml_sem I (FUrename x y (Exists z φ))) = (Radj x y ν ∈ fml_sem I (Exists z φ))"
by auto
qed
done
then show ?case by auto
next
case (PRadmit_Assign z θ)
have "hpsafe (Assign z θ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ)))"
apply (cases "z = x")
subgoal for ν ω
proof -
assume fsafe:"hpsafe (Assign z θ)"
assume zx:"z = x"
from fsafe have dsafe:"dsafe θ" by auto
have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
have "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((ν, ω) ∈ prog_sem I (Assign y (TUrename x y θ)))" using zx by auto
moreover have "... = (ω = repv ν y (dterm_sem I (TUrename x y θ) ν))" by auto
moreover have "... = (ω = repv ν y (dterm_sem I θ (Radj x y ν)))" using IH' by auto
moreover have "... = (Radj x y ω = Radj x y (repv ν y (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
moreover have "... = (Radj x y ω = repv (Radj x y ν) x (dterm_sem I θ (Radj x y ν)))" using Radj_repv1 by auto
moreover have "... = (Radj x y ω = repv (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zx by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ))" by auto
ultimately
show "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ))"
by auto
qed
apply (cases "z = y")
subgoal for ν ω
proof -
assume fsafe:"hpsafe (Assign z θ)"
assume zy:"z = y"
from fsafe have dsafe:"dsafe θ" by auto
have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
have "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((ν, ω) ∈ prog_sem I (Assign x (TUrename x y θ)))" using zy by auto
moreover have "... = (ω = repv ν x (dterm_sem I (TUrename x y θ) ν))" by auto
moreover have "... = (ω = repv ν x (dterm_sem I θ (Radj x y ν)))" using IH' by auto
moreover have "... = (Radj x y ω = Radj x y (repv ν x (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
moreover have "... = (Radj x y ω = repv (Radj x y ν) y (dterm_sem I θ (Radj x y ν)))" using Radj_repv2 by auto
moreover have "... = (Radj x y ω = repv (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zy by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ))" by auto
ultimately
show "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ))"
by auto
qed
subgoal for ν ω
proof -
assume fsafe:"hpsafe (Assign z θ)"
assume zx:"z ≠ x" and zy:"z ≠ y"
from fsafe have dsafe:"dsafe θ" by auto
have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
have "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((ν, ω) ∈ prog_sem I (Assign z (TUrename x y θ)))" using zx zy by auto
moreover have "... = (ω = repv ν z (dterm_sem I (TUrename x y θ) ν))" by auto
moreover have "... = (ω = repv ν z (dterm_sem I θ (Radj x y ν)))" using IH' by auto
moreover have "... = (Radj x y ω = Radj x y (repv ν z (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
moreover have "... = (Radj x y ω = repv (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using Radj_repv3[OF zx zy] by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ))" by auto
ultimately
show "((ν, ω) ∈ prog_sem I (PUrename x y (Assign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (Assign z θ))"
by auto
qed
done
then show ?case by auto
next
case (PRadmit_DiffAssign z θ)
have "hpsafe (DiffAssign z θ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ)))"
apply (cases "z = x")
subgoal for ν ω
proof -
assume fsafe:"hpsafe (DiffAssign z θ)"
assume zx:"z = x"
from fsafe have dsafe:"dsafe θ" by auto
have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
have "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((ν, ω) ∈ prog_sem I (DiffAssign y (TUrename x y θ)))" using zx by auto
moreover have "... = (ω = repd ν y (dterm_sem I (TUrename x y θ) ν))" by auto
moreover have "... = (ω = repd ν y (dterm_sem I θ (Radj x y ν)))" using IH' by auto
moreover have "... = (Radj x y ω = Radj x y (repd ν y (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
moreover have "... = (Radj x y ω = repd (Radj x y ν) x (dterm_sem I θ (Radj x y ν)))" using Radj_repd1 by auto
moreover have "... = (Radj x y ω = repd (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zx by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ))" by auto
ultimately
show "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ))"
by auto
qed
apply (cases "z = y")
subgoal for ν ω
proof -
assume fsafe:"hpsafe (DiffAssign z θ)"
assume zy:"z = y"
from fsafe have dsafe:"dsafe θ" by auto
have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
have "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((ν, ω) ∈ prog_sem I (DiffAssign x (TUrename x y θ)))" using zy by auto
moreover have "... = (ω = repd ν x (dterm_sem I (TUrename x y θ) ν))" by auto
moreover have "... = (ω = repd ν x (dterm_sem I θ (Radj x y ν)))" using IH' by auto
moreover have "... = (Radj x y ω = Radj x y (repd ν x (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
moreover have "... = (Radj x y ω = repd (Radj x y ν) y (dterm_sem I θ (Radj x y ν)))" using Radj_repd2 by auto
moreover have "... = (Radj x y ω = repd (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using zy by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ))" by auto
ultimately
show "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ))"
by auto
qed
subgoal for ν ω
proof -
assume fsafe:"hpsafe (DiffAssign z θ)"
assume zx:"z ≠ x" and zy:"z ≠ y"
from fsafe have dsafe:"dsafe θ" by auto
have IH':"(⋀ν. dterm_sem I (TUrename x y θ) ν = dterm_sem I θ (Radj x y ν))"
subgoal for ν using TUren[OF good_interp dsafe , of x y ν] by auto done
have "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((ν, ω) ∈ prog_sem I (DiffAssign z (TUrename x y θ)))" using zx zy by auto
moreover have "... = (ω = repd ν z (dterm_sem I (TUrename x y θ) ν))" by auto
moreover have "... = (ω = repd ν z (dterm_sem I θ (Radj x y ν)))" using IH' by auto
moreover have "... = (Radj x y ω = Radj x y (repd ν z (dterm_sem I θ (Radj x y ν))))" using Radj_eq_iff by auto
moreover have "... = (Radj x y ω = repd (Radj x y ν) z (dterm_sem I θ (Radj x y ν)))" using Radj_repd3[OF zx zy] by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ))" by auto
ultimately
show "((ν, ω) ∈ prog_sem I (PUrename x y (DiffAssign z θ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (DiffAssign z θ))"
by auto
qed
done
then show ?case by auto
next
case (PRadmit_Test φ) then
have FRA:"FRadmit φ"
and IH:"fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
by auto
have "hpsafe (? φ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (? φ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (? φ)))"
proof -
assume hpsafe:"hpsafe (? φ)"
fix ν ω
from hpsafe have fsafe:"fsafe φ" by auto
have IH':"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)"
by (rule IH[OF fsafe])
have "((ν, ω) ∈ prog_sem I (PUrename x y (? φ))) = (ν = ω ∧ (ω ∈ fml_sem I (FUrename x y φ)))" by (cases ω, auto)
moreover have "... = (ν = ω ∧ (Radj x y ω) ∈ fml_sem I φ)" using IH' by auto
moreover have "... = (Radj x y ν = Radj x y ω ∧ (Radj x y ω) ∈ fml_sem I φ)" using Radj_eq_iff by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (? φ))" by (cases "Radj x y ω", auto)
ultimately show "?thesis ν ω" by auto
qed
then show ?case by auto
next
case (FRadmit_Prop p args) then
have "fsafe (Prop p args) ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y (Prop p args))) = ((Radj x y ν) ∈ fml_sem I (Prop p args)))"
proof -
assume fsafe:"fsafe (Prop p args)"
fix ν
from fsafe have dsafes:"⋀i. dsafe (args i)" using dfree_is_dsafe by auto
have IH:"⋀i ν. dterm_sem I (TUrename x y (args i)) ν = dterm_sem I (args i) (Radj x y ν)"
using TUren[OF good_interp dsafes] by auto
have "(ν ∈ fml_sem I (FUrename x y (Prop p args))) = (ν ∈ fml_sem I (Prop p (λi . TUrename x y (args i))))" by auto
moreover have "... = (Predicates I p (χ i. dterm_sem I (TUrename x y (args i)) ν))" by auto
moreover have "... = (Predicates I p (χ i. dterm_sem I (args i) (Radj x y ν)))" using IH by auto
moreover have "... = ((Radj x y ν) ∈ fml_sem I (Prop p args))" by auto
ultimately show "?thesis ν" by blast
qed
then show ?case by auto
next
case (PRadmit_Sequence a b) then
have IH1:"hpsafe a ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a))"
and IH2:"hpsafe b ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y b)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I b))"
by auto
have "hpsafe (a ;; b) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (a ;;b))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a ;; b)))"
proof -
assume hpsafe:"hpsafe (a ;; b)"
fix ν ω
from hpsafe have safe1:"hpsafe a" and safe2:"hpsafe b" by auto
have IH1:"(⋀μ. ((ν, μ) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y μ) ∈ prog_sem I a))"
using IH1[OF safe1] by auto
have IH2:"(⋀μ. ((μ, ω) ∈ prog_sem I (PUrename x y b)) = ((Radj x y μ, Radj x y ω) ∈ prog_sem I b))"
using IH2[OF safe2] by auto
have "((ν, ω) ∈ prog_sem I (PUrename x y (a ;;b))) = ((ν, ω) ∈ prog_sem I ((PUrename x y a) ;;(PUrename x y b)))" by auto
moreover have "... = (∃μ. (ν, μ) ∈ prog_sem I (PUrename x y a) ∧ (μ, ω) ∈ prog_sem I (PUrename x y b))" by auto
moreover have "... = (∃μ. (Radj x y ν, Radj x y μ) ∈ prog_sem I a ∧ (Radj x y μ, Radj x y ω) ∈ prog_sem I b)" using IH1 IH2 by auto
moreover have "... = (∃μ. (Radj x y ν, μ) ∈ prog_sem I a ∧ (μ, Radj x y ω) ∈ prog_sem I b)"
apply auto
subgoal for aa ba
apply(rule exI[where x="fst(Radj x y (aa,ba))"])
apply(rule exI[where x="snd(Radj x y (aa,ba))"])
by auto
subgoal for aa ba
apply(rule exI[where x="fst(Radj x y (aa,ba))"])
apply(rule exI[where x="snd(Radj x y (aa,ba))"])
using Radj_cancel by auto
done
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a ;;b))" by (auto,blast)
ultimately show "?thesis ν ω" by auto
qed
then show ?case by auto
next
case (FRadmit_Diamond α φ) then
have IH1:"hpsafe α ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y α)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I α))"
and IH2:"fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
by auto
have "fsafe (⟨α⟩φ) ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y (⟨α⟩φ))) = (Radj x y ν ∈ fml_sem I (⟨α⟩φ)))"
proof -
assume safe:"fsafe (⟨α⟩φ)"
fix ν
from safe have safe1:"hpsafe α" and safe2:"fsafe φ" by auto
have IH1:"⋀ω. ((ν, ω) ∈ prog_sem I (PUrename x y α)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I α)"
using IH1[OF safe1] by auto
have IH2:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ)"
by (rule IH2[OF safe2])
have "(ν ∈ fml_sem I (FUrename x y (⟨α⟩φ))) = (ν ∈ fml_sem I (⟨PUrename x y α⟩FUrename x y φ))" by auto
moreover have "... = (∃ ω. (ν, ω) ∈ prog_sem I (PUrename x y α) ∧ ω ∈ fml_sem I (FUrename x y φ))" by auto
moreover have "... = (∃ ω. (Radj x y ν, Radj x y ω) ∈ prog_sem I α ∧ (Radj x y ω) ∈ fml_sem I φ)"
using IH1 IH2 by auto
moreover have "... = (∃ ω. (Radj x y ν, ω) ∈ prog_sem I α ∧ ω ∈ fml_sem I φ)"
apply auto
subgoal for aa ba
apply(rule exI[where x="fst(Radj x y (aa,ba))"])
apply(rule exI[where x="snd(Radj x y (aa,ba))"])
by auto
subgoal for aa ba
apply(rule exI[where x="fst(Radj x y (aa,ba))"])
apply(rule exI[where x="snd(Radj x y (aa,ba))"])
using Radj_cancel by auto
done
moreover have "... = (Radj x y ν ∈ fml_sem I (⟨α⟩φ))" by auto
ultimately show "?thesis ν" by auto
qed
then show ?case by auto
next
case (PRadmit_Loop a) then
have IH:" hpsafe a ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a))"
by auto
have "hpsafe (a** ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (a** ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a** )))"
proof -
assume safe:"hpsafe (a** )"
fix ν ω
from safe have safe:"hpsafe a" by auto
have IH1:"(⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a)) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a))"
by (rule IH[OF safe])
have relpow_iff:"⋀ν ω R n. ((ν, ω) ∈ R ^^ Suc n) = (∃μ. (ν, μ) ∈ R ∧ (μ, ω) ∈ R ^^ n)"
apply auto
subgoal for R n x y z by (auto simp add: relpow_Suc_D2')
subgoal for ν ω R n μ using relpow_Suc_I2 by fastforce
done
have rtrancl_iff_relpow:"⋀ν ω R. ((ν, ω) ∈ R⇧*) = (∃n. (ν, ω) ∈ R ^^ n)"
using rtrancl_imp_relpow relpow_imp_rtrancl by blast
have lem:"⋀n. (∀ ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a)^^n) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a^^n))"
subgoal for n
proof(induction n)
case 0
then show ?case using Radj_eq_iff by auto
next
case (Suc n) then
have IH2:"⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a) ^^ n) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a ^^ n)"
by auto
have "⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y a) ^^ Suc n) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a ^^ Suc n)"
proof -
fix ν ω
have "((ν, ω) ∈ prog_sem I (PUrename x y a) ^^ Suc n)
= (∃ μ. (ν, μ) ∈ prog_sem I (PUrename x y a) ∧ (μ, ω) ∈ prog_sem I (PUrename x y a) ^^ n)"
using relpow_iff[of ν ω n "prog_sem I (PUrename x y a)"] by auto
moreover have "... = (∃ μ. (Radj x y ν, Radj x y μ) ∈ prog_sem I a ∧ (Radj x y μ, Radj x y ω) ∈ prog_sem I a ^^ n)"
using IH1 IH2 by blast
moreover have "... = (∃ μ. (Radj x y ν, μ) ∈ prog_sem I a ∧ (μ, Radj x y ω) ∈ prog_sem I a ^^ n)"
apply auto
subgoal for aa ba
apply(rule exI[where x="fst(Radj x y (aa,ba))"])
apply(rule exI[where x="snd(Radj x y (aa,ba))"])
by auto
subgoal for aa ba
apply(rule exI[where x="fst(Radj x y (aa,ba))"])
apply(rule exI[where x="snd(Radj x y (aa,ba))"])
using Radj_cancel by auto
done
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I a ^^ Suc n)"
using relpow_iff[of "Radj x y ν" "Radj x y ω" n "prog_sem I a"] by auto
ultimately show "?thesis ν ω" by auto
qed
then show ?case by auto
qed
done
have "((ν, ω) ∈ prog_sem I (PUrename x y (a** ))) = ((ν, ω) ∈ (prog_sem I (PUrename x y a))⇧*)" by auto
moreover have "... = (∃n. (ν, ω) ∈ (prog_sem I (PUrename x y a)) ^^ n)"
using rtrancl_iff_relpow[of ν ω "prog_sem I (PUrename x y a)"] by auto
moreover have "... = (∃n. (Radj x y ν, Radj x y ω) ∈ (prog_sem I a) ^^ n)"
using lem by blast
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ (prog_sem I a)⇧*)"
using rtrancl_iff_relpow[of "Radj x y ν" "Radj x y ω" "prog_sem I a"] by auto
moreover have "... = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (a** ))" by auto
ultimately show "?thesis ν ω" by blast
qed
then show ?case by auto
next
case (PRadmit_EvolveODE ODE φ) then
have ORA:"ORadmit ODE"
and IH:"fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
by auto
have "hpsafe (EvolveODE ODE φ) ⟹ (⋀ν ω. ((ν, ω) ∈ prog_sem I (PUrename x y (EvolveODE ODE φ))) = ((Radj x y ν, Radj x y ω) ∈ prog_sem I (EvolveODE ODE φ)))"
proof -
assume safe:"hpsafe (EvolveODE ODE φ)"
fix ν ω
from safe have osafe:"osafe ODE" and fsafe:"fsafe φ" by auto
have IH1:"⋀ν. (ν ∈ fml_sem I (FUrename x y φ) = (Radj x y ν ∈ fml_sem I φ))" by (rule IH[OF fsafe])
have IH2:"⋀ν. ODE_sem I (OUrename x y ODE) ν = RSadj x y (ODE_sem I ODE (RSadj x y ν))"
using OUren[OF ORA] by auto
have RSadj_Radj:"⋀a b. (RSadj x y a, RSadj x y b) = Radj x y (a,b)"
unfolding RSadj_def Radj_def by auto
have Radj_swap:"⋀a b. Radj x y a = b ⟹ a = Radj x y b"
using Radj_cancel Radj_eq_iff by metis
have mkv:"⋀t sol b. Radj x y (mk_v I (OUrename x y ODE) (sol 0, b) (sol t)) = mk_v I ODE (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol t))"
using mkv_lemma[OF ORA] by blast
have mkv2:"⋀t sol b. Radj x y ω = mk_v I ODE (sol 0, b) (sol t) ⟹
ω = mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) (RSadj x y (sol t))"
using mkv_lemma[OF ORA] by (metis RSadj_cancel Radj_cancel)
have sol:"⋀t sol b. 0 ≤ t ⟹
(sol solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t} {xa. mk_v I (OUrename x y ODE) (sol 0, b) xa ∈ fml_sem I (FUrename x y φ)} ⟹
((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I ODE)) {0..t} {xa. mk_v I ODE (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I φ}"
using sol_lemma IH1 IH2 ORA by blast
have sol2:"⋀t sol b. 0 ≤ t ⟹
(sol solves_ode (λa. ODE_sem I ODE)) {0..t} {x. mk_v I ODE (sol 0, b) x ∈ fml_sem I φ} ⟹
((λt. RSadj x y (sol t)) solves_ode (λa. ODE_sem I (OUrename x y ODE))) {0..t}
{xa. mk_v I (OUrename x y ODE) (RSadj x y (sol 0), RSadj x y b) xa ∈ fml_sem I (FUrename x y φ)}"
using sol_lemma2 IH1 IH2 ORA by blast
show "?thesis ν ω"
apply auto
subgoal for b sol t
apply(rule exI[where x= "RSadj x y b"])
apply(rule exI[where x= "(λt. RSadj x y (sol t))"])
apply(rule conjI)
subgoal using RSadj_Radj[of "sol 0" "b"] by auto
apply(rule exI[where x =t])
apply(rule conjI)
subgoal by (rule mkv)
apply(rule conjI)
subgoal by assumption
by (rule sol)
subgoal for b sol t
apply(rule exI[where x= "RSadj x y b"])
apply(rule exI[where x= "(λt. RSadj x y (sol t))"])
apply(rule conjI)
subgoal using RSadj_Radj[of "sol 0" "b"] Radj_swap[of ν "(sol 0,b)"] by auto
apply(rule exI[where x =t])
apply(rule conjI)
subgoal by (rule mkv2)
apply(rule conjI)
subgoal by assumption
by (rule sol2)
done
qed
then show ?case by auto
qed (auto simp add: Radj_def)
lemma FUren:"is_interp I ⟹ FRadmit φ ⟹ fsafe φ ⟹ (⋀ν. (ν ∈ fml_sem I (FUrename x y φ)) = (Radj x y ν ∈ fml_sem I φ))"
using PUren_FUren by blast
subsection ‹Uniform Renaming Rule Soundness›
lemma URename_sound:"FRadmit φ ⟹ fsafe φ ⟹ valid φ ⟹ valid (FUrename x y φ)"
unfolding valid_def using FUren by blast
subsection ‹Bound Renaming Rule Soundness›
lemma BRename_sound:
assumes FRA:"FRadmit([[Assign x θ]]φ)"
assumes fsafe:"fsafe ([[Assign x θ]]φ)"
assumes valid:"valid ([[Assign x θ]]φ)"
assumes FVF:"{Inl y, Inr y, Inr x} ∩ FVF φ = {}"
shows "valid([[Assign y θ]]FUrename x y φ)"
proof -
have FRA':"FRadmit φ" using FRA
by (metis (no_types, lifting) Box_def FRadmit.cases formula.distinct(15) formula.distinct(21) formula.distinct(27) formula.distinct(29) formula.distinct(3) formula.distinct(31) formula.distinct formula.distinct(9) formula.inject(3) formula.inject(6))
have fsafe':"fsafe φ" using fsafe by (simp add: Box_def)
have dsafe:"dsafe θ" using fsafe by (simp add: Box_def)
have "⋀I ν. is_interp I ⟹ ν ∈ fml_sem I ([[y := θ]]FUrename x y φ)"
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good_interp:"is_interp I"
from FVF have sub:"FVF φ ⊆ -{Inl y, Inr y, Inr x}" by auto
have "Vagree (repv (Radj x y ν) x (dterm_sem I θ ν)) (repv ν x (dterm_sem I θ ν)) (-{Inl y, Inr y, Inr x})"
unfolding Vagree_def using FVF unfolding Radj_def RSadj_def by auto
then have agree:"Vagree (repv (Radj x y ν) x (dterm_sem I θ ν)) (repv ν x (dterm_sem I θ ν)) (FVF φ)"
using agree_sub[OF sub] by auto
have fml_sem_eq:"(repv (Radj x y ν) x (dterm_sem I θ ν) ∈ fml_sem I φ) = (repv ν x (dterm_sem I θ ν) ∈ fml_sem I φ)"
using coincidence_formula[OF fsafe' Iagree_refl agree] by auto
have "(ν ∈ fml_sem I ([[y := θ]]FUrename x y φ)) = (repv ν y (dterm_sem I θ ν) ∈ fml_sem I (FUrename x y φ))"
by auto
moreover have "... = (Radj x y (repv ν y (dterm_sem I θ ν)) ∈ fml_sem I φ)"
using FUren[OF good_interp FRA' fsafe'] by auto
moreover have "... = (repv (Radj x y ν) x (dterm_sem I θ ν) ∈ fml_sem I φ)"
using Radj_repv1 by auto
moreover have "... = (ν ∈ fml_sem I ([[x := θ]]φ))"
using fml_sem_eq by auto
moreover have "... = True"
using valid unfolding valid_def using good_interp by blast
ultimately
show "ν ∈ fml_sem I ([[y := θ]]FUrename x y φ)"
by blast
qed
then
show ?thesis unfolding valid_def by auto
qed
end end
Theory Pretty_Printer
theory "Pretty_Printer"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
begin
context ids begin
section‹Syntax Pretty-Printer›
text ‹
The deeply-embedded syntax is difficult to read for large formulas.
This pretty-printer produces a more human-friendly syntax,
which can be helpful if you want to produce a proof term by hand for
the proof checker (not recommended for most users).
›
fun join :: "string ⇒ char list list ⇒ char list"
where "join S [] = []"
| "join S [S'] = S'"
| "join S (S' # SS) = S' @ S @ (join S SS)"
fun vid_to_string::"'sz ⇒ char list"
where "vid_to_string vid = (if vid = vid1 then ''x'' else if vid = vid2 then ''y'' else if vid = vid3 then ''z'' else ''w'')"
fun oid_to_string::"'sz ⇒ char list"
where "oid_to_string vid = (if vid = vid1 then ''c'' else if vid = vid2 then ''c2'' else if vid = vid3 then ''c3'' else ''c4'')"
fun cid_to_string::"'sc ⇒ char list"
where "cid_to_string vid = (if vid = pid1 then ''C'' else if vid = pid2 then ''C2'' else if vid = pid3 then ''C3'' else ''C4'')"
fun ppid_to_string::"'sc ⇒ char list"
where "ppid_to_string vid = (if vid = pid1 then ''P'' else if vid = pid2 then ''Q'' else if vid = pid3 then ''R'' else ''H'')"
fun hpid_to_string::"'sz ⇒ char list"
where "hpid_to_string vid = (if vid = vid1 then ''a'' else if vid = vid2 then ''b'' else if vid = vid3 then ''a1'' else ''b1'')"
fun fid_to_string::"'sf ⇒ char list"
where "fid_to_string vid = (if vid = fid1 then ''f'' else if vid = fid2 then ''g'' else if vid = fid3 then ''h'' else ''j'')"
primrec trm_to_string::"('sf,'sz) trm ⇒ char list"
where
"trm_to_string (Var x) = vid_to_string x"
| "trm_to_string (Const r) = ''r''"
| "trm_to_string (Function f args) = fid_to_string f"
| "trm_to_string (Plus t1 t2) = trm_to_string t1 @ ''+'' @ trm_to_string t2"
| "trm_to_string (Times t1 t2) = trm_to_string t1 @ ''*'' @ trm_to_string t2"
| "trm_to_string (DiffVar x) = ''Dv{'' @ vid_to_string x @ ''}''"
| "trm_to_string (Differential t) = ''D{'' @ trm_to_string t @ ''}''"
primrec ode_to_string::"('sf,'sz) ODE ⇒ char list"
where
"ode_to_string (OVar x) = oid_to_string x"
| "ode_to_string (OSing x t) = ''d'' @ vid_to_string x @ ''='' @ trm_to_string t"
| "ode_to_string (OProd ODE1 ODE2) = ode_to_string ODE1 @ '', '' @ ode_to_string ODE2 "
fun fml_to_string ::"('sf, 'sc, 'sz) formula ⇒ char list"
and hp_to_string ::"('sf, 'sc, 'sz) hp ⇒ char list"
where
"fml_to_string (Geq t1 t2) = trm_to_string t1 @ ''>='' @ trm_to_string t2"
| "fml_to_string (Prop p args) = []"
| "fml_to_string (Not p) =
(case p of (And (Not q) (Not (Not p))) ⇒ fml_to_string p @ ''->'' @ fml_to_string q
| (Exists x (Not p)) ⇒ ''A''@ vid_to_string x @ ''.'' @ fml_to_string p
| (Diamond a (Not p)) ⇒ ''[''@ hp_to_string a @ '']'' @ fml_to_string p
| (And (Not (And p q)) (Not (And (Not p') (Not q')))) ⇒
(if (p = p' ∧ q = q') then fml_to_string p @ ''<->'' @ fml_to_string q else ''!'' @ fml_to_string (And (Not (And p q)) (Not (And (Not p') (Not q')))))
| _ ⇒ ''!'' @ fml_to_string p)"
| "fml_to_string (And p q) = fml_to_string p @ ''&'' @ fml_to_string q"
| "fml_to_string (Exists x p) = ''E'' @ vid_to_string x @ '' . '' @ fml_to_string p"
| "fml_to_string (Diamond a p) = ''<'' @ hp_to_string a @ ''>'' @ fml_to_string p"
| "fml_to_string (InContext C p) =
(case p of
(Geq _ _) ⇒ ppid_to_string C
| _ ⇒ cid_to_string C @ ''('' @ fml_to_string p @ '')'')"
| "hp_to_string (Pvar a) = hpid_to_string a"
| "hp_to_string (Assign x e) = vid_to_string x @ '':='' @ trm_to_string e"
| "hp_to_string (DiffAssign x e) = ''D{'' @ vid_to_string x @ ''}:='' @ trm_to_string e"
| "hp_to_string (Test p) = ''?'' @ fml_to_string p"
| "hp_to_string (EvolveODE ODE p) = ''{'' @ ode_to_string ODE @ ''&'' @ fml_to_string p @ ''}''"
| "hp_to_string (Choice a b) = hp_to_string a @ ''U'' @ hp_to_string b"
| "hp_to_string (Sequence a b) = hp_to_string a @ '';'' @ hp_to_string b"
| "hp_to_string (Loop a) = hp_to_string a @ ''*''"
end end
Theory Proof_Checker
theory "Proof_Checker"
imports
Ordinary_Differential_Equations.ODE_Analysis
"Ids"
"Lib"
"Syntax"
"Denotational_Semantics"
"Axioms"
"Differential_Axioms"
"Frechet_Correctness"
"Static_Semantics"
"Coincidence"
"Bound_Effect"
"Uniform_Renaming"
"USubst_Lemma"
"Pretty_Printer"
begin context ids begin
section ‹Proof Checker›
text ‹This proof checker defines a datatype for proof terms in dL and a function for checking proof
terms, with a soundness proof that any proof accepted by the checker is a proof of a sound rule or
valid formula.
A simple concrete hybrid system and a differential invariant rule for conjunctions are provided
as example proofs.
›
lemma sound_weaken_gen:"⋀A B C. sublist A B ⟹ sound (A, C) ⟹ sound (B,C)"
proof (rule soundI_mem)
fix A B::"('sf,'sc,'sz) sequent list"
and C::"('sf,'sc,'sz) sequent"
and I::"('sf,'sc,'sz) interp"
assume sub:"sublist A B"
assume good:"is_interp I"
assume "sound (A, C)"
then have soundC:"(⋀φ. List.member A φ ⟹ seq_sem I φ = UNIV) ⟹ seq_sem I C = UNIV"
apply simp
apply(drule soundD_mem)
by (auto simp add: good)
assume SG:"(⋀φ. List.member B φ ⟹ seq_sem I φ = UNIV)"
show "seq_sem I C = UNIV"
using soundC SG sub unfolding sublist_def by auto
qed
lemma sound_weaken:"⋀SG SGS C. sound (SGS, C) ⟹ sound (SG # SGS, C)"
subgoal for SG SGS C
apply(induction SGS)
subgoal unfolding sound_def by auto
subgoal for SG2 SGS
unfolding sound_def
by (metis fst_conv le0 length_Cons not_less_eq nth_Cons_Suc snd_conv)
done
done
lemma member_filter:"⋀P. List.member (filter P L) x ⟹ List.member L x"
apply(induction L, auto)
by(metis (full_types) member_rec(1))
lemma nth_member:"n < List.length L ⟹ List.member L (List.nth L n)"
apply(induction L, auto simp add: member_rec)
by (metis in_set_member length_Cons nth_mem set_ConsD)
lemma mem_appL:"List.member A x ⟹ List.member (A @ B) x"
by(induction A, auto simp add: member_rec)
lemma sound_weaken_appR:"⋀SG SGS C. sound (SG, C) ⟹ sound (SG @ SGS, C)"
subgoal for SG SGS C
apply(rule sound_weaken_gen)
apply(auto)
unfolding sublist_def apply(rule allI)
subgoal for x
using mem_appL[of SG x SGS] by auto
done
done
fun start_proof::"('sf,'sc,'sz) sequent ⇒ ('sf,'sc,'sz) rule"
where "start_proof S = ([S], S)"
lemma start_proof_sound:"sound (start_proof S)"
unfolding sound_def by auto
section ‹Proof Checker Implementation›
datatype axiom =
AloopIter | AI | Atest | Abox | Achoice | AK | AV | Aassign | Adassign
| AdConst | AdPlus | AdMult
| ADW | ADE | ADC | ADS | ADIGeq | ADIGr | ADG
fun get_axiom:: "axiom ⇒ ('sf,'sc,'sz) formula"
where
"get_axiom AloopIter = loop_iterate_axiom"
| "get_axiom AI = Iaxiom"
| "get_axiom Atest = test_axiom"
| "get_axiom Abox = box_axiom"
| "get_axiom Achoice = choice_axiom"
| "get_axiom AK = Kaxiom"
| "get_axiom AV = Vaxiom"
| "get_axiom Aassign = assign_axiom"
| "get_axiom Adassign = diff_assign_axiom"
| "get_axiom AdConst = diff_const_axiom"
| "get_axiom AdPlus = diff_plus_axiom"
| "get_axiom AdMult = diff_times_axiom"
| "get_axiom ADW = DWaxiom"
| "get_axiom ADE = DEaxiom"
| "get_axiom ADC = DCaxiom"
| "get_axiom ADS = DSaxiom"
| "get_axiom ADIGeq = DIGeqaxiom"
| "get_axiom ADIGr = DIGraxiom"
| "get_axiom ADG = DGaxiom"
lemma axiom_safe:"fsafe (get_axiom a)"
by(cases a, auto simp add: axiom_defs Box_def Or_def Equiv_def Implies_def empty_def Equals_def f1_def p1_def P_def f0_def expand_singleton Forall_def Greater_def id_simps)
lemma axiom_valid:"valid (get_axiom a)"
proof (cases a)
case AloopIter
then show ?thesis by (simp add: loop_valid)
next
case AI
then show ?thesis by (simp add: I_valid)
next
case Atest
then show ?thesis by (simp add: test_valid)
next
case Abox
then show ?thesis by (simp add: box_valid)
next
case Achoice
then show ?thesis by (simp add: choice_valid)
next
case AK
then show ?thesis by (simp add: K_valid)
next
case AV
then show ?thesis by (simp add: V_valid)
next
case Aassign
then show ?thesis by (simp add: assign_valid)
next
case Adassign
then show ?thesis by (simp add: diff_assign_valid)
next
case AdConst
then show ?thesis by (simp add: diff_const_axiom_valid)
next
case AdPlus
then show ?thesis by (simp add: diff_plus_axiom_valid)
next
case AdMult
then show ?thesis by (simp add: diff_times_axiom_valid)
next
case ADW
then show ?thesis by (simp add: DW_valid)
next
case ADE
then show ?thesis by (simp add: DE_valid)
next
case ADC
then show ?thesis by (simp add: DC_valid)
next
case ADS
then show ?thesis by (simp add: DS_valid)
next
case ADIGeq
then show ?thesis by (simp add: DIGeq_valid)
next
case ADIGr
then show ?thesis by (simp add: DIGr_valid)
next
case ADG
then show ?thesis by (simp add: DG_valid)
qed
datatype rrule = ImplyR | AndR | CohideR | CohideRR | TrueR | EquivR
datatype lrule = ImplyL | AndL | EquivForwardL | EquivBackwardL
datatype ('a, 'b, 'c) step =
Axiom axiom
| MP
| G
| CT
| CQ "('a, 'c) trm" "('a, 'c) trm" "('a, 'b, 'c) subst"
| CE "('a, 'b, 'c) formula" "('a, 'b, 'c) formula" "('a, 'b, 'c) subst"
| Skolem
| VSubst "('a, 'b, 'c) formula" "('a, 'b, 'c) subst"
| AxSubst axiom "('a, 'b, 'c) subst"
| URename
| BRename
| Rrule rrule nat
| Lrule lrule nat
| CloseId nat nat
| Cut "('a, 'b, 'c) formula"
| DEAxiomSchema "('a,'c) ODE" "('a, 'b, 'c) subst"
type_synonym ('a, 'b, 'c) derivation = "(nat * ('a, 'b, 'c) step) list"
type_synonym ('a, 'b, 'c) pf = "('a,'b,'c) sequent * ('a, 'b, 'c) derivation"
fun seq_to_string :: "('sf, 'sc, 'sz) sequent ⇒ char list"
where "seq_to_string (A,S) = join '', '' (map fml_to_string A) @ '' |- '' @ join '', '' (map fml_to_string S)"
fun rule_to_string :: "('sf, 'sc, 'sz) rule ⇒ char list"
where "rule_to_string (SG, C) = (join '';; '' (map seq_to_string SG)) @ '' '' @ seq_to_string C"
fun close :: "'a list ⇒ 'a ⇒'a list"
where "close L x = filter (λy. y ≠ x) L"
fun closeI ::"'a list ⇒ nat ⇒'a list"
where "closeI L i = close L (nth L i)"
lemma close_sub:"sublist (close Γ φ) Γ"
apply (auto simp add: sublist_def)
using member_filter by fastforce
lemma close_app_comm:"close (A @ B) x = close A x @ close B x"
by auto
lemma close_provable_sound:"sound (SG, C) ⟹ sound (close SG φ, φ) ⟹ sound (close SG φ, C)"
proof (rule soundI_mem)
fix I::"('sf,'sc,'sz) interp"
assume S1:"sound (SG, C)"
assume S2:"sound (close SG φ, φ)"
assume good:"is_interp I"
assume SGCs:"(⋀φ'. List.member (close SG φ) φ' ⟹ seq_sem I φ' = UNIV)"
have Sφ:"seq_sem I φ = UNIV"
using S2 apply simp
apply(drule soundD_mem)
using good apply auto
using SGCs UNIV_I by fastforce
have mem_close:"⋀P. List.member SG P ⟹ P ≠ φ ⟹ List.member (close SG φ) P"
by(induction SG, auto simp add: member_rec)
have SGs:"⋀P. List.member SG P ⟹ seq_sem I P = UNIV"
subgoal for P
apply(cases "P = φ")
subgoal using Sφ by auto
subgoal using mem_close[of P] SGCs by auto
done
done
show "seq_sem I C = UNIV"
using S1 apply simp
apply(drule soundD_mem)
using good apply auto
using SGs apply auto
using impl_sem by blast
qed
fun Lrule_result :: "lrule ⇒ nat ⇒ ('sf, 'sc, 'sz) sequent ⇒ ('sf, 'sc, 'sz) sequent list"
where "Lrule_result AndL j (A,S) = (case (nth A j) of And p q ⇒ [(close ([p, q] @ A) (nth A j), S)])"
| "Lrule_result ImplyL j (A,S) = (case (nth A j) of Not (And (Not q) (Not (Not p))) ⇒
[(close (q # A) (nth A j), S), (close A (nth A j), p # S)])"
| "Lrule_result EquivForwardL j (A,S) = (case (nth A j) of Not(And (Not (And p q)) (Not (And (Not p') (Not q')))) ⇒
[(close (q # A) (nth A j), S), (close A (nth A j), p # S)])"
| "Lrule_result EquivBackwardL j (A,S) = (case (nth A j) of Not(And (Not (And p q)) (Not (And (Not p') (Not q')))) ⇒
[(close (p # A) (nth A j), S), (close A (nth A j), q # S)])"
fun Rrule_result :: "rrule ⇒ nat ⇒ ('sf, 'sc, 'sz) sequent ⇒ ('sf, 'sc, 'sz) sequent list"
where
Rstep_Imply:"Rrule_result ImplyR j (A,S) = (case (nth S j) of Not (And (Not q) (Not (Not p))) ⇒ [(p # A, q # (closeI S j))] | _ ⇒ undefined)"
| Rstep_And:"Rrule_result AndR j (A,S) = (case (nth S j) of (And p q) ⇒ [(A, p # (closeI S j )), (A, q # (closeI S j))])"
| Rstep_EquivR:"Rrule_result EquivR j (A,S) =
(case (nth S j) of Not(And (Not (And p q)) (Not (And (Not p') (Not q')))) ⇒
(if (p = p' ∧ q = q') then [(p # A, q # (closeI S j)), (q # A, p # (closeI S j))]
else undefined))"
| Rstep_CohideR:"Rrule_result CohideR j (A,S) = [(A, [nth S j])]"
| Rstep_CohideRR:"Rrule_result CohideRR j (A,S) = [([], [nth S j])]"
| Rstep_TrueR:"Rrule_result TrueR j (A,S) = []"
fun step_result :: "('sf, 'sc, 'sz) rule ⇒ (nat * ('sf, 'sc, 'sz) step) ⇒ ('sf, 'sc, 'sz) rule"
where
Step_axiom:"step_result (SG,C) (i,Axiom a) = (closeI SG i, C)"
| Step_AxSubst:"step_result (SG,C) (i,AxSubst a σ) = (closeI SG i, C)"
| Step_Lrule:"step_result (SG,C) (i,Lrule L j) = (close (append SG (Lrule_result L j (nth SG i))) (nth SG i), C)"
| Step_Rrule:"step_result (SG,C) (i,Rrule L j) = (close (append SG (Rrule_result L j (nth SG i))) (nth SG i), C)"
| Step_Cut:"step_result (SG,C) (i,Cut φ) = (let (A,S) = nth SG i in ((φ # A, S) # ((A, φ # S) # (closeI SG i)), C))"
| Step_Vsubst:"step_result (SG,C) (i,VSubst φ σ) = (closeI SG i, C)"
| Step_CloseId:"step_result (SG,C) (i,CloseId j k) = (closeI SG i, C)"
| Step_G:"step_result (SG,C) (i,G) = (case nth SG i of (_, (Not (Diamond q (Not p))) # Nil) ⇒ (([], [p]) # closeI SG i, C))"
| Step_DEAxiomSchema:"step_result (SG,C) (i,DEAxiomSchema ODE σ) = (closeI SG i, C)"
| Step_CE:"step_result (SG,C) (i, CE φ ψ σ) = (closeI SG i, C)"
| Step_CQ:"step_result (SG,C) (i, CQ θ⇩1 θ⇩2 σ) = (closeI SG i, C)"
| Step_default:"step_result R (i,S) = R"
fun deriv_result :: "('sf, 'sc, 'sz) rule ⇒ ('sf, 'sc, 'sz) derivation ⇒ ('sf, 'sc, 'sz) rule"
where
"deriv_result R [] = R"
| "deriv_result R (s # ss) = deriv_result (step_result R s) (ss)"
fun proof_result :: "('sf, 'sc, 'sz) pf ⇒ ('sf, 'sc, 'sz) rule"
where "proof_result (D,S) = deriv_result (start_proof D) S"
inductive lrule_ok ::"('sf,'sc,'sz) sequent list ⇒ ('sf,'sc,'sz) sequent ⇒ nat ⇒ nat ⇒ lrule ⇒ bool"
where
Lrule_And:"⋀p q. nth (fst (nth SG i)) j = (p && q) ⟹ lrule_ok SG C i j AndL"
| Lrule_Imply:"⋀p q. nth (fst (nth SG i)) j = (p → q) ⟹ lrule_ok SG C i j ImplyL"
| Lrule_EquivForward:"⋀p q. nth (fst (nth SG i)) j = (p ↔ q) ⟹ lrule_ok SG C i j EquivForwardL"
| Lrule_EquivBackward:"⋀p q. nth (fst (nth SG i)) j = (p ↔ q) ⟹ lrule_ok SG C i j EquivBackwardL"
named_theorems prover "Simplification rules for checking validity of proof certificates"
lemmas [prover] = axiom_defs Box_def Or_def Implies_def filter_append ssafe_def SDom_def FUadmit_def PFUadmit_def id_simps
inductive_simps
Lrule_And[prover]: "lrule_ok SG C i j AndL"
and Lrule_Imply[prover]: "lrule_ok SG C i j ImplyL"
and Lrule_Forward[prover]: "lrule_ok SG C i j EquivForwardL"
and Lrule_EquivBackward[prover]: "lrule_ok SG C i j EquivBackwardL"
inductive rrule_ok ::"('sf,'sc,'sz) sequent list ⇒ ('sf,'sc,'sz) sequent ⇒ nat ⇒ nat ⇒ rrule ⇒ bool"
where
Rrule_And:"⋀p q. nth (snd (nth SG i)) j = (p && q) ⟹ rrule_ok SG C i j AndR"
| Rrule_Imply:"⋀p q. nth (snd (nth SG i)) j = (p → q) ⟹ rrule_ok SG C i j ImplyR"
| Rrule_Equiv:"⋀p q. nth (snd (nth SG i)) j = (p ↔ q) ⟹ rrule_ok SG C i j EquivR"
| Rrule_Cohide:"length (snd (nth SG i)) > j ⟹ (⋀Γ q. (nth SG i) ≠ (Γ, [q])) ⟹ rrule_ok SG C i j CohideR"
| Rrule_CohideRR:"length (snd (nth SG i)) > j ⟹ (⋀q. (nth SG i) ≠ ([], [q])) ⟹ rrule_ok SG C i j CohideRR"
| Rrule_True:"nth (snd (nth SG i)) j = TT ⟹ rrule_ok SG C i j TrueR"
inductive_simps
Rrule_And_simps[prover]: "rrule_ok SG C i j AndR"
and Rrule_Imply_simps[prover]: "rrule_ok SG C i j ImplyR"
and Rrule_Equiv_simps[prover]: "rrule_ok SG C i j EquivR"
and Rrule_CohideR_simps[prover]: "rrule_ok SG C i j CohideR"
and Rrule_CohideRR_simps[prover]: "rrule_ok SG C i j CohideRR"
and Rrule_TrueR_simps[prover]: "rrule_ok SG C i j TrueR"
inductive step_ok :: "('sf, 'sc, 'sz) rule ⇒ nat ⇒ ('sf, 'sc, 'sz) step ⇒ bool"
where
Step_Axiom:"(nth SG i) = ([], [get_axiom a]) ⟹ step_ok (SG,C) i (Axiom a)"
| Step_AxSubst:"(nth SG i) = ([], [Fsubst (get_axiom a) σ]) ⟹ Fadmit σ (get_axiom a) ⟹ ssafe σ ⟹ step_ok (SG,C) i (AxSubst a σ)"
| Step_Lrule:"lrule_ok SG C i j L ⟹ j < length (fst (nth SG i)) ⟹ step_ok (SG,C) i (Lrule L j)"
| Step_Rrule:"rrule_ok SG C i j L ⟹ j < length (snd (nth SG i)) ⟹ step_ok (SG,C) i (Rrule L j)"
| Step_Cut:"fsafe φ ⟹ i < length SG ⟹ step_ok (SG,C) i (Cut φ)"
| Step_CloseId:"nth (fst (nth SG i)) j = nth (snd (nth SG i)) k ⟹ j < length (fst (nth SG i)) ⟹ k < length (snd (nth SG i)) ⟹ step_ok (SG,C) i (CloseId j k) "
| Step_G:"⋀a p. nth SG i = ([], [([[a]]p)]) ⟹ step_ok (SG,C) i G"
| Step_DEAxiom_schema:
" nth SG i =
([], [Fsubst ((([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1))) ODE) (p1 vid2 vid1)]]
[[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))) σ])
⟹ ssafe σ
⟹ osafe ODE
⟹ {Inl vid1, Inr vid1} ∩ BVO ODE = {}
⟹ Fadmit σ ((([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]] (P pid1)) ↔
([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
[[DiffAssign vid1 (f1 fid1 vid1)]]P pid1)))
⟹ step_ok (SG,C) i (DEAxiomSchema ODE σ)"
| Step_CE:"nth SG i = ([], [Fsubst (Equiv (InContext pid1 φ) (InContext pid1 ψ)) σ])
⟹ valid (Equiv φ ψ)
⟹ fsafe φ
⟹ fsafe ψ
⟹ ssafe σ
⟹ Fadmit σ (Equiv (InContext pid1 φ) (InContext pid1 ψ))
⟹ step_ok (SG,C) i (CE φ ψ σ)"
| Step_CQ:"nth SG i = ([], [Fsubst (Equiv (Prop p (singleton θ)) (Prop p (singleton θ'))) σ])
⟹ valid (Equals θ θ')
⟹ dsafe θ
⟹ dsafe θ'
⟹ ssafe σ
⟹ Fadmit σ (Equiv (Prop p (singleton θ)) (Prop p (singleton θ')))
⟹ step_ok (SG,C) i (CQ θ θ' σ)"
inductive_simps
Step_G_simps[prover]: "step_ok (SG,C) i G"
and Step_CloseId_simps[prover]: "step_ok (SG,C) i (CloseId j k)"
and Step_Cut_simps[prover]: "step_ok (SG,C) i (Cut φ)"
and Step_Rrule_simps[prover]: "step_ok (SG,C) i (Rrule j L)"
and Step_Lrule_simps[prover]: "step_ok (SG,C) i (Lrule j L)"
and Step_Axiom_simps[prover]: "step_ok (SG,C) i (Axiom a)"
and Step_AxSubst_simps[prover]: "step_ok (SG,C) i (AxSubst a σ)"
and Step_DEAxiom_schema_simps[prover]: "step_ok (SG,C) i (DEAxiomSchema ODE σ)"
and Step_CE_simps[prover]: "step_ok (SG,C) i (CE φ ψ σ)"
and Step_CQ_simps[prover]: "step_ok (SG,C) i (CQ θ θ' σ)"
inductive deriv_ok :: "('sf, 'sc, 'sz) rule ⇒ ('sf, 'sc, 'sz) derivation ⇒ bool"
where
Deriv_Nil:"deriv_ok R Nil"
| Deriv_Cons:"step_ok R i S ⟹ i ≥ 0 ⟹ i < length (fst R) ⟹ deriv_ok (step_result R (i,S)) SS ⟹ deriv_ok R ((i,S) # SS)"
inductive_simps
Deriv_nil_simps[prover]: "deriv_ok R Nil"
and Deriv_cons_simps[prover]: "deriv_ok R ((i,S)#SS)"
inductive proof_ok :: "('sf, 'sc, 'sz) pf ⇒ bool"
where
Proof_ok:"deriv_ok (start_proof D) S ⟹ proof_ok (D,S)"
inductive_simps Proof_ok_simps[prover]: "proof_ok (D,S)"
subsection ‹Soundness›
named_theorems member_intros "Prove that stuff is in lists"
lemma mem_sing[member_intros]:"⋀x. List.member [x] x"
by(auto simp add: member_rec)
lemma mem_appR[member_intros]:"⋀A B x. List.member B x ⟹ List.member (A @ B) x"
subgoal for A by(induction A, auto simp add: member_rec) done
lemma mem_filter[member_intros]:"⋀A P x. P x ⟹ List.member A x ⟹ List.member (filter P A) x"
subgoal for A
by(induction A, auto simp add: member_rec)
done
lemma sound_weaken_appL:"⋀SG SGS C. sound (SGS, C) ⟹ sound (SG @ SGS, C)"
subgoal for SG SGS C
apply(rule sound_weaken_gen)
apply(auto)
unfolding sublist_def apply(rule allI)
subgoal for x
using mem_appR[of SGS x SG] by auto
done
done
lemma fml_seq_valid:"valid φ ⟹ seq_valid ([], [φ])"
unfolding seq_valid_def valid_def by auto
lemma closeI_provable_sound:"⋀i. sound (SG, C) ⟹ sound (closeI SG i, (nth SG i)) ⟹ sound (closeI SG i, C)"
using close_provable_sound by auto
lemma valid_to_sound:"seq_valid A ⟹ sound (B, A)"
unfolding seq_valid_def sound_def by auto
lemma closeI_valid_sound:"⋀i. sound (SG, C) ⟹ seq_valid (nth SG i) ⟹ sound (closeI SG i, C)"
using valid_to_sound closeI_provable_sound by auto
lemma close_nonmember_eq:"¬(List.member A a) ⟹ close A a = A"
by (induction A, auto simp add: member_rec)
lemma close_noneq_nonempty:"List.member A x ⟹ x ≠ a ⟹ close A a ≠ []"
by(induction A, auto simp add: member_rec)
lemma close_app_neq:"List.member A x ⟹ x ≠ a ⟹ close (A @ B) a ≠ B"
using append_self_conv2[of "close A a" "close B a"] append_self_conv2[of "close A a" "B"] close_app_comm[of A B a] close_noneq_nonempty[of A x a]
apply(cases "close B a = B")
apply (auto)
by (metis (no_types, lifting) filter_True filter_append mem_Collect_eq set_filter)
lemma member_singD:"⋀x P. P x ⟹ (⋀y. List.member [x] y ⟹ P y)"
by (metis member_rec(1) member_rec(2))
lemma fst_neq:"A ≠ B ⟹ (A,C) ≠ (B,D)"
by auto
lemma lrule_sound: "lrule_ok SG C i j L ⟹ i < length SG ⟹ j < length (fst (SG ! i)) ⟹ sound (SG,C) ⟹ sound (close (append SG (Lrule_result L j (nth SG i))) (nth SG i), C)"
proof(induction rule: lrule_ok.induct)
case (Lrule_And SG i j C p q)
assume eq:"fst (SG ! i) ! j = (p && q)"
assume sound:"sound (SG, C)"
obtain AI and SI where SG_dec:"(AI,SI) = (SG ! i)"
by (metis seq2fml.cases)
have AIjeq:"AI ! j = (p && q)" using SG_dec eq
by (metis fst_conv)
have sub:"sublist [(close ([p, q] @ AI) (p && q),SI)] ([y←SG . y ≠ (AI, SI)] @ [y← [(close (p # q # AI) (p && q), SI)] . y ≠ (AI, SI)])"
apply (rule sublistI)
using member_singD [of "λy. List.member ([y←SG . y ≠ (AI, SI)] @ [y← [(close ([p, q] @ AI) (p && q), SI)] . y ≠ (AI, SI)]) y" "(close ([p, q] @ AI) (p && q),SI)"]
using close_app_neq[of "[p, q]" p "p && q" AI]
by(auto intro: member_intros fst_neq simp add: member_rec expr_diseq)
have cool:"sound ([y←SG . y ≠ (AI, SI)] @ [y← [(close (p # q # AI) (p && q), SI)] . y ≠ (AI, SI)], AI, SI)"
apply(rule sound_weaken_gen[OF sub] )
apply(auto simp add: member_rec expr_diseq)
unfolding seq_valid_def
proof (rule soundI_mem)
fix I::"('sf,'sc,'sz) interp"
assume good:"is_interp I"
assume sgs:"(⋀φ. List.member [(p # q # [y←AI . y ≠ (p && q)], SI)] φ ⟹ seq_sem I φ = UNIV)"
have theSg:"seq_sem I (p # q # [y←AI . y ≠ (p && q)], SI) = UNIV"
apply(rule sgs)
by(auto intro: member_intros)
then have sgIn:"⋀ν. ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
by auto
{ fix ν
assume sem:"ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
have mem_eq:"⋀x. List.member ((p && q) # [y←AI . y ≠ (p && q)]) x = List.member AI x"
by (metis (mono_tags, lifting) Lrule_And.prems(2) SG_dec eq fst_conv local.member_filter mem_filter member_rec(1) nth_member)
have myeq:"ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI) ⟹ ν ∈ seq_sem I (AI, SI)"
using and_foldl_sem and_foldl_sem_conv seq_semI Lrule_And.prems(2) SG_dec eq seq_MP seq_semI' mem_eq
by (metis (no_types, lifting))
have "ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
using sem by auto
then have "ν ∈ seq_sem I ((p && q) # [y←AI . y ≠ (p && q)], SI)"
by blast
then have "ν ∈ seq_sem I (AI, SI)"
using myeq by auto}
then show "seq_sem I (AI, SI) = UNIV"
using sgIn by blast
qed
have res_sound:"sound ([y←SG . y ≠ (AI,SI)] @ [y←Lrule_result AndL j (AI,SI) . y ≠ (AI,SI)],(AI,SI))"
apply (simp)
using cool AIjeq by auto
show "?case"
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
using res_sound SG_dec by auto
next
case (Lrule_Imply SG i j C p q)
have implyL_simp:"⋀AI SI SS p q.
(nth AI j) = (Not (And (Not q) (Not (Not p)))) ⟹
(AI,SI) = SS ⟹
Lrule_result ImplyL j SS = [(close (q # AI) (nth AI j), SI), (close AI (nth AI j), p # SI)]"
subgoal for AI SI SS p q apply(cases SS) by auto done
assume eq:"fst (SG ! i) ! j = (p → q)"
assume iL:"i < length SG"
assume jL:"j < length (fst (SG ! i))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have res_eq:"Lrule_result ImplyL j (SG ! i) =
[(close (q # Γ) (nth Γ j), Δ),
(close Γ (nth Γ j), p # Δ)]"
apply(rule implyL_simp)
using SG_dec eq Implies_def Or_def
by (metis fstI)+
have AIjeq:"Γ ! j = (p → q)"
using SG_dec eq unfolding Implies_def Or_def
by (metis fst_conv)
have big_sound:"sound ([(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good:"is_interp I"
assume sgs:"(⋀i. 0 ≤ i ⟹
i < length [(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)] ⟹
ν ∈ seq_sem I ([(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)] ! i))"
have sg1:"ν ∈ seq_sem I (close (q # Γ) (p → q), Δ)" using sgs[of 0] by auto
have sg2:"ν ∈ seq_sem I (close Γ (p → q), p # Δ)" using sgs[of "Suc 0"] by auto
assume Γ:"ν ∈ fml_sem I (foldr And Γ TT)"
have Γ_proj:"⋀φ Γ. List.member Γ φ ⟹ ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I φ"
apply(induction Γ, auto simp add: member_rec)
using and_foldl_sem by blast
have imp:"ν ∈ fml_sem I (p → q)"
apply(rule Γ_proj[of Γ])
using AIjeq jL SG_dec nth_member
apply (metis fst_conv)
by (rule Γ)
have sub:"sublist (close Γ (p → q)) Γ"
by (rule close_sub)
have ΓC:"ν ∈ fml_sem I (foldr And (close Γ (p → q)) TT)"
by (rule Γ_sub_sem[OF sub Γ])
have "ν ∈ fml_sem I (foldr (||) (p # Δ) FF)"
by(rule seq_MP[OF sg2 ΓC])
then have disj:"ν ∈ fml_sem I p ∨ ν ∈ fml_sem I (foldr (||) Δ FF)"
by auto
{ assume p:"ν ∈ fml_sem I p"
have q:"ν ∈ fml_sem I q" using p imp by simp
have res: "ν ∈ fml_sem I (foldr (||) Δ FF)"
using disj Γ seq_semI
proof -
have "ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
using Γ q by auto
then show ?thesis
by (meson Γ_sub_sem close_sub seq_MP sg1)
qed
have conj:"ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
using q Γ by auto
have conj:"ν ∈ fml_sem I (foldr (&&) (close (q # Γ) (p → q)) TT)"
apply(rule Γ_sub_sem)
defer
apply(rule conj)
by(rule close_sub)
have Δ1:"ν ∈ fml_sem I (foldr (||) Δ FF)"
by(rule seq_MP[OF sg1 conj])
}
then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using disj by auto
qed
have neq1:"close ([q] @ Γ) (p → q) ≠ Γ"
apply(rule close_app_neq)
apply(rule mem_sing)
by (auto simp add: expr_diseq)
have neq2:"p # Δ ≠ Δ"
by(induction p, auto)
have close_eq:"close [(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)] (Γ,Δ) = [(close (q # Γ) (p → q), Δ), (close Γ (p → q), p # Δ)]"
apply(rule close_nonmember_eq)
apply auto
using neq1 neq2
apply (simp add: member_rec)
proof -
assume a1: "q = (p → q)"
assume "List.member [([y←Γ . y ≠ q], Δ), ([y←Γ . y ≠ q], p # Δ)] (Γ, Δ)"
then have "[f←Γ . f ≠ q] = Γ"
by (simp add: member_rec)
then show False
using a1 neq1 by fastforce
qed
show ?case
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
apply(unfold res_eq)
apply(unfold AIjeq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using close_eq big_sound SG_dec
by simp
next
case (Lrule_EquivBackward SG i j C p q)
have equivLBackward_simp:"⋀AI SI SS p q.
(nth AI j) = Not (And (Not (And p q)) (Not (And (Not p) (Not q)))) ⟹
(AI,SI) = SS ⟹
Lrule_result EquivBackwardL j SS = [(close (p # AI) (nth AI j), SI), (close AI (nth AI j), q # SI)]"
subgoal for AI SI SS p q apply(cases SS) by auto done
assume eq:"fst (SG ! i) ! j = (p ↔ q)"
assume iL:"i < length SG"
assume jL:"j < length (fst (SG ! i))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have res_eq:"Lrule_result EquivBackwardL j (SG ! i) =
[(close (p # Γ) (nth Γ j), Δ),
(close Γ (nth Γ j), q # Δ)]"
apply(rule equivLBackward_simp)
using SG_dec eq Equiv_def Or_def
by (metis fstI)+
have AIjeq:"Γ ! j = (p ↔ q)"
using SG_dec eq unfolding Implies_def Or_def
by (metis fst_conv)
have big_sound:"sound ([(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good:"is_interp I"
assume sgs:"(⋀i. 0 ≤ i ⟹
i < length [(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)] ⟹
ν ∈ seq_sem I ([(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)] ! i))"
have sg1:"ν ∈ seq_sem I (close (p # Γ) (p ↔ q), Δ)" using sgs[of 0] by auto
have sg2:"ν ∈ seq_sem I (close Γ (p ↔ q), q # Δ)" using sgs[of "Suc 0"] by auto
assume Γ:"ν ∈ fml_sem I (foldr And Γ TT)"
have Γ_proj:"⋀φ Γ. List.member Γ φ ⟹ ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I φ"
apply(induction Γ, auto simp add: member_rec)
using and_foldl_sem by blast
have imp:"ν ∈ fml_sem I (p ↔ q)"
apply(rule Γ_proj[of Γ])
using AIjeq jL SG_dec nth_member
apply (metis fst_conv)
by (rule Γ)
have sub:"sublist (close Γ (p → q)) Γ"
by (rule close_sub)
have ΓC:"ν ∈ fml_sem I (foldr And (close Γ (p → q)) TT)"
by (rule Γ_sub_sem[OF sub Γ])
have "ν ∈ fml_sem I (foldr (||) (p # Δ) FF)"
by (metis Γ Γ_sub_sem close_sub iff_sem imp member_rec(1) or_foldl_sem or_foldl_sem_conv seq_MP sg2)
then have disj:"ν ∈ fml_sem I p ∨ ν ∈ fml_sem I (foldr (||) Δ FF)"
by auto
{ assume p:"ν ∈ fml_sem I p"
have q:"ν ∈ fml_sem I q" using p imp by simp
have res: "ν ∈ fml_sem I (foldr (||) Δ FF)"
using disj Γ seq_semI
proof -
have "ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
using Γ q by auto
then show ?thesis
proof -
have "∀fs p i. (∃f. List.member fs (f::('sf, 'sc, 'sz) formula) ∧ p ∉ fml_sem i f) ∨ p ∈ fml_sem i (foldr (&&) fs TT)"
using and_foldl_sem_conv by blast
then obtain ff :: "('sf, 'sc, 'sz) formula list ⇒ (real, 'sz) vec × (real, 'sz) vec ⇒ ('sf, 'sc, 'sz) interp ⇒ ('sf, 'sc, 'sz) formula" where
f1: "∀fs p i. List.member fs (ff fs p i) ∧ p ∉ fml_sem i (ff fs p i) ∨ p ∈ fml_sem i (foldr (&&) fs TT)"
by metis
have "⋀f. ν ∈ fml_sem I f ∨ ¬ List.member Γ f"
by (meson ‹ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)› and_foldl_sem member_rec(1))
then have "ν ∈ fml_sem I (foldr (&&) (close (p # Γ) (p ↔ q)) TT)"
using f1 by (metis (no_types) close_sub local.sublist_def member_rec(1) p)
then show ?thesis
using seq_MP sg1 by blast
qed
qed
have conj:"ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
using q Γ by auto
have conj:"ν ∈ fml_sem I (foldr (&&) (close (q # Γ) (p → q)) TT)"
apply(rule Γ_sub_sem)
defer
apply(rule conj)
by(rule close_sub)
have Δ1:"ν ∈ fml_sem I (foldr (||) Δ FF)"
using res by blast
}
then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using disj by auto
qed
have neq1:"close ([q] @ Γ) (p ↔ q) ≠ Γ"
apply(rule close_app_neq)
apply(rule mem_sing)
by (auto simp add: expr_diseq)
have neq2:"p # Δ ≠ Δ"
by(induction p, auto)
have close_eq:"close [(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)] (Γ,Δ) = [(close (p # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), q # Δ)]"
apply(rule close_nonmember_eq)
apply auto
using neq1 neq2
apply (simp add: member_rec)
apply (metis append_Cons append_Nil close.simps close_app_neq member_rec(1))
proof -
assume a1:"p = (p ↔ q)"
then show False
by (simp add: expr_diseq)
qed
show ?case
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
apply(unfold res_eq)
apply(unfold AIjeq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using close_eq big_sound SG_dec
by simp
next
case (Lrule_EquivForward SG i j C p q)
have equivLForward_simp:"⋀AI SI SS p q.
(nth AI j) = Not (And (Not (And p q)) (Not (And (Not p) (Not q)))) ⟹
(AI,SI) = SS ⟹
Lrule_result EquivForwardL j SS = [(close (q # AI) (nth AI j), SI), (close AI (nth AI j), p # SI)]"
subgoal for AI SI SS p q apply(cases SS) by auto done
assume eq:"fst (SG ! i) ! j = (p ↔ q)"
assume iL:"i < length SG"
assume jL:"j < length (fst (SG ! i))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have res_eq:"Lrule_result EquivForwardL j (SG ! i) =
[(close (q # Γ) (nth Γ j), Δ),
(close Γ (nth Γ j), p # Δ)]"
apply(rule equivLForward_simp)
using SG_dec eq Equiv_def Or_def
by (metis fstI)+
have AIjeq:"Γ ! j = (p ↔ q)"
using SG_dec eq unfolding Implies_def Or_def
by (metis fst_conv)
have big_sound:"sound ([(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good:"is_interp I"
assume sgs:"(⋀i. 0 ≤ i ⟹
i < length [(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)] ⟹
ν ∈ seq_sem I ([(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)] ! i))"
have sg1:"ν ∈ seq_sem I (close (q # Γ) (p ↔ q), Δ)" using sgs[of 0] by auto
have sg2:"ν ∈ seq_sem I (close Γ (p ↔ q), p # Δ)" using sgs[of "Suc 0"] by auto
assume Γ:"ν ∈ fml_sem I (foldr And Γ TT)"
have Γ_proj:"⋀φ Γ. List.member Γ φ ⟹ ν ∈ fml_sem I (foldr And Γ TT) ⟹ ν ∈ fml_sem I φ"
apply(induction Γ, auto simp add: member_rec)
using and_foldl_sem by blast
have imp:"ν ∈ fml_sem I (p ↔ q)"
apply(rule Γ_proj[of Γ])
using AIjeq jL SG_dec nth_member
apply (metis fst_conv)
by (rule Γ)
have sub:"sublist (close Γ (p → q)) Γ"
by (rule close_sub)
have ΓC:"ν ∈ fml_sem I (foldr And (close Γ (p → q)) TT)"
by (rule Γ_sub_sem[OF sub Γ])
have "ν ∈ fml_sem I (foldr (||) (p # Δ) FF)"
by (metis Γ Γ_sub_sem close_sub iff_sem imp member_rec(1) or_foldl_sem or_foldl_sem_conv seq_MP sg2)
then have disj:"ν ∈ fml_sem I p ∨ ν ∈ fml_sem I (foldr (||) Δ FF)"
by auto
{ assume p:"ν ∈ fml_sem I p"
have q:"ν ∈ fml_sem I q" using p imp by simp
have res: "ν ∈ fml_sem I (foldr (||) Δ FF)"
using disj Γ seq_semI
proof -
have "ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
using Γ q by auto
then show ?thesis
by (meson ‹ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)› and_foldl_sem and_foldl_sem_conv close_sub local.sublist_def seq_MP sg1)
qed
have conj:"ν ∈ fml_sem I (foldr (&&) (q # Γ) TT)"
using q Γ by auto
have conj:"ν ∈ fml_sem I (foldr (&&) (close (q # Γ) (p → q)) TT)"
apply(rule Γ_sub_sem)
defer
apply(rule conj)
by(rule close_sub)
have Δ1:"ν ∈ fml_sem I (foldr (||) Δ FF)"
using res by blast
}
then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using disj by auto
qed
have neq1:"close ([q] @ Γ) (p ↔ q) ≠ Γ"
apply(rule close_app_neq)
apply(rule mem_sing)
by (auto simp add: expr_diseq)
have neq2:"p # Δ ≠ Δ"
by(induction p, auto)
have close_eq:"close [(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)] (Γ,Δ) = [(close (q # Γ) (p ↔ q), Δ), (close Γ (p ↔ q), p # Δ)]"
apply(rule close_nonmember_eq)
apply auto
using neq1 neq2
apply (simp add: member_rec)
proof -
assume a1:"q = (p ↔ q)"
then show False
by (simp add: expr_diseq)
qed
show ?case
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
apply(unfold res_eq)
apply(unfold AIjeq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using close_eq big_sound SG_dec
by simp
qed
lemma rrule_sound: "rrule_ok SG C i j L ⟹ i < length SG ⟹ j < length (snd (SG ! i)) ⟹ sound (SG,C) ⟹ sound (close (append SG (Rrule_result L j (nth SG i))) (nth SG i), C)"
proof(induction rule: rrule_ok.induct)
case (Rrule_And SG i j C p q)
assume eq:"snd (SG ! i) ! j = (p && q)"
assume "i < length SG"
assume "j < length (snd (SG ! i))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have andR_simp:"⋀Γ Δ SS p q.
(nth Δ j) = And p q ⟹
(Γ,Δ) = SS ⟹
Rrule_result AndR j SS = [(Γ, p # (close Δ (nth Δ j))), (Γ, q # (close Δ (nth Δ j)))]"
subgoal for AI SI SS p q apply(cases SS) by auto done
have res_eq:"Rrule_result AndR j (SG ! i) =
[(Γ, p # (close Δ (nth Δ j))), (Γ, q # (close Δ (nth Δ j)))]"
using SG_dec andR_simp apply auto
using SG_dec eq Implies_def Or_def
using fstI
by (metis andR_simp close.simps snd_conv)
have AIjeq:"Δ ! j = (p && q)"
using SG_dec eq snd_conv
by metis
have big_sound:"sound ([(Γ, p # (close Δ (nth Δ j))), (Γ, q # (close Δ (nth Δ j)))], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
proof -
fix I::"('sf,'sc,'sz) interp" and ν
assume good:"is_interp I"
assume sgs:"(⋀i. 0 ≤ i ⟹
i < length [(Γ, p # close Δ (nth Δ j)), (Γ, q # close Δ (nth Δ j))] ⟹
ν ∈ seq_sem I (nth [(Γ, p # close Δ (nth Δ j)), (Γ, q # close Δ (nth Δ j))] i))"
assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
have sg1:"ν ∈ seq_sem I (Γ, p # close Δ (nth Δ j))" using sgs[of 0] by auto
have sg2:"ν ∈ seq_sem I (Γ, q # close Δ (nth Δ j))" using sgs[of 1] by auto
have Δ1:"ν ∈ fml_sem I (foldr (||) (p # close Δ (nth Δ j)) FF)"
by(rule seq_MP[OF sg1 Γ_sem])
have Δ2:"ν ∈ fml_sem I (foldr (||) (q # close Δ (nth Δ j)) FF)"
by(rule seq_MP[OF sg2 Γ_sem])
have Δ':"ν ∈ fml_sem I (foldr (||) ((p && q) # close Δ (nth Δ j)) FF)"
using Δ1 Δ2 by auto
have mem_eq:"⋀x. List.member ((p && q) # close Δ (nth Δ j)) x ⟹ List.member Δ x"
using Rrule_And.prems SG_dec eq member_rec(1) nth_member
by (metis close_sub local.sublist_def snd_conv)
have myeq:"ν ∈ fml_sem I (foldr (||) ((p && q) # close Δ (nth Δ j)) FF) ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
using seq_semI Rrule_And.prems SG_dec eq seq_MP seq_semI' mem_eq
or_foldl_sem or_foldl_sem_conv
by metis
then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using Δ' by auto
qed
have list_neqI1:"⋀L1 L2 x. List.member L1 x ⟹ ¬(List.member L2 x) ⟹ L1 ≠ L2"
by(auto)
have list_neqI2:"⋀L1 L2 x. ¬(List.member L1 x) ⟹ (List.member L2 x) ⟹ L1 ≠ L2"
by(auto)
have notin_cons:"⋀x y ys. x ≠ y ⟹ ¬(List.member ys x) ⟹ ¬(List.member (y # ys) x)"
subgoal for x y ys
by(induction ys, auto simp add: member_rec)
done
have notin_close:"⋀L x. ¬(List.member (close L x) x)"
subgoal for L x
by(induction L, auto simp add: member_rec)
done
have neq_lemma:"⋀L x y. List.member L x ⟹ y ≠ x ⟹ (y # (close L x)) ≠ L"
subgoal for L x y
apply(cases "List.member L y")
subgoal
apply(rule list_neqI2[of "y # close L x" x])
apply(rule notin_cons)
defer
apply(rule notin_close)
by(auto)
subgoal
apply(rule list_neqI2[of "y # close L x" x])
apply(rule notin_cons)
defer
apply(rule notin_close)
by(auto)
done
done
have neq1:"p # close Δ (p && q) ≠ Δ"
apply(rule neq_lemma)
apply (metis Rrule_And.prems(2) SG_dec eq nth_member sndI)
by(auto simp add: expr_diseq)
have neq2:"q # close Δ (p && q) ≠ Δ"
apply(rule neq_lemma)
apply (metis Rrule_And.prems(2) SG_dec eq nth_member sndI)
by(auto simp add: expr_diseq)
have close_eq:"close [(Γ, p # close Δ (p && q)), (Γ, q # close Δ (p && q))] (Γ,Δ) = [(Γ, p # close Δ (p && q)), (Γ, q # close Δ (p && q))]"
apply(rule close_nonmember_eq)
apply auto
using neq1 neq2
by (simp add: member_rec)
show " sound (close (SG @ Rrule_result AndR j (SG ! i)) (SG ! i), C)"
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
apply(unfold res_eq)
apply(unfold AIjeq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using close_eq big_sound SG_dec
by (simp add: AIjeq)
next
case (Rrule_Imply SG i j C p q)
assume eq:"snd (SG ! i) ! j = (p → q)"
assume "i < length SG"
assume "j < length (snd (SG ! i))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have impR_simp:"⋀Γ Δ SS p q.
(nth Δ j) = Implies p q ⟹
(Γ,Δ) = SS ⟹
Rrule_result ImplyR j SS = [(p # Γ, q # (close Δ (nth Δ j)))]"
subgoal for AI SI SS p q apply(cases SS) by (auto simp add: Implies_def Or_def) done
have res_eq:"Rrule_result ImplyR j (SG ! i) =
[(p # Γ, q # (close Δ (nth Δ j)))]"
using SG_dec impR_simp apply auto
using SG_dec eq Implies_def Or_def
using fstI
by (metis impR_simp close.simps snd_conv)
have AIjeq:"Δ ! j = (p → q)"
using SG_dec eq snd_conv
by metis
have close_eq:"close [(p # Γ, q # (close Δ (nth Δ j)))] (Γ,Δ) = [(p # Γ, q # (close Δ (nth Δ j)))]"
apply(rule close_nonmember_eq)
by (simp add: member_rec)
have big_sound:"sound ([(p # Γ, q # close Δ (Δ ! j))], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
proof -
fix I ::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume "is_interp I"
assume sgs:"(⋀i. 0 ≤ i ⟹ i < length [(p # Γ, q # close Δ (Δ ! j))] ⟹ ν ∈ seq_sem I ([(p # Γ, q # close Δ (Δ ! j))] ! i))"
have sg:"ν ∈ seq_sem I (p # Γ, q # close Δ (Δ ! j))" using sgs[of 0] by auto
assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using Γ_sem sg
AIjeq Rrule_Imply.prems(2) SG_dec and_foldl_sem_conv close_sub impl_sem local.sublist_def member_rec(1) nth_member or_foldl_sem_conv seq_MP seq_semI snd_conv
Γ_sub_sem and_foldl_sem or_foldl_sem seq_sem.simps sublistI
proof -
have f1: "∀fs p i. ∃f. (p ∈ fml_sem i (foldr (&&) fs (TT::('sf, 'sc, 'sz) formula)) ∨ List.member fs f) ∧ (p ∉ fml_sem i f ∨ p ∈ fml_sem i (foldr (&&) fs TT))"
using and_foldl_sem_conv by blast
have "∀p i fs. ∃f. ∀pa ia fa fb pb ib fc fd. p ∈ fml_sem i (f::('sf, 'sc, 'sz) formula) ∧ (pa ∈ fml_sem ia (fa::('sf, 'sc, 'sz) formula) ∨ pa ∈ fml_sem ia (fa → fb)) ∧ (pb ∉ fml_sem ib (fc::('sf, 'sc, 'sz) formula) ∨ pb ∈ fml_sem ib (fd → fc)) ∧ (p ∉ fml_sem i (foldr (||) fs FF) ∨ List.member fs f)"
by (metis impl_sem or_foldl_sem_conv)
then obtain ff :: "(real, 'sz) vec × (real, 'sz) vec ⇒ ('sf, 'sc, 'sz) interp ⇒ ('sf, 'sc, 'sz) formula list ⇒ ('sf, 'sc, 'sz) formula" where
f2: "⋀p i fs pa ia f fa pb ib fb fc. p ∈ fml_sem i (ff p i fs) ∧ (pa ∈ fml_sem ia (f::('sf, 'sc, 'sz) formula) ∨ pa ∈ fml_sem ia (f → fa)) ∧ (pb ∉ fml_sem ib (fb::('sf, 'sc, 'sz) formula) ∨ pb ∈ fml_sem ib (fc → fb)) ∧ (p ∉ fml_sem i (foldr (||) fs FF) ∨ List.member fs (ff p i fs))"
by metis
then have "⋀fs. ν ∉ fml_sem I (foldr (&&) (p # Γ) TT) ∨ ¬ local.sublist (close Δ (p → q)) fs ∨ ff ν I (q # close Δ (p → q)) = q ∨ List.member fs (ff ν I (q # close Δ (p → q)))"
by (metis (no_types) AIjeq local.sublist_def member_rec(1) seq_MP sg)
then have "∃f. List.member Δ f ∧ ν ∈ fml_sem I f"
using f2 f1 by (metis (no_types) AIjeq Rrule_Imply.prems(2) SG_dec Γ_sem and_foldl_sem close_sub member_rec(1) nth_member snd_conv)
then show ?thesis
using or_foldl_sem by blast
qed
qed
show ?case
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
using res_eq
apply(unfold res_eq)
apply(unfold AIjeq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using close_eq big_sound SG_dec AIjeq
by (simp add: AIjeq)
next
case (Rrule_Cohide SG i j C)
assume "i < length SG"
assume "j < length (snd (SG ! i))"
assume chg:"(⋀Γ q. (nth SG i) ≠ (Γ, [q]))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have cohideR_simp:"
(Γ,Δ) = SS ⟹
Rrule_result CohideR j SS = [(Γ, [nth Δ j])]" for Γ Δ SS p q
by (cases SS, auto)
have res_eq:"Rrule_result CohideR j (SG ! i) = [(Γ, [nth Δ j])]"
using SG_dec by (rule cohideR_simp)
have close_eq:"close [(Γ, [nth Δ j])] (Γ,Δ) = [(Γ, [nth Δ j])]"
using chg
by (metis SG_dec close_nonmember_eq member_rec(1) member_rec(2))
have big_sound:"sound ([(Γ, [nth Δ j])], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
by (metis (no_types, lifting) Rrule_Cohide.prems(2) SG_dec length_greater_0_conv less_or_eq_imp_le list.distinct(1) member_singD nth_Cons_0 nth_member or_foldl_sem or_foldl_sem_conv seq_MP snd_conv)
show ?case
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
using res_eq
apply(unfold res_eq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using big_sound SG_dec
apply(cases "[nth Δ j] = Δ")
apply(auto)
using chg by (metis)+
next
case (Rrule_CohideRR SG i j C)
assume "i < length SG"
assume "j < length (snd (SG ! i))"
assume chg:"(⋀q. (nth SG i) ≠ ([], [q]))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have cohideRR_simp:"
(Γ,Δ) = SS ⟹
Rrule_result CohideRR j SS = [([], [nth Δ j])]" for Γ Δ SS p q
by (cases SS, auto)
have res_eq:"Rrule_result CohideRR j (SG ! i) = [([], [nth Δ j])]"
using SG_dec by (rule cohideRR_simp)
have close_eq:"close [([], [nth Δ j])] (Γ,Δ) = [([], [nth Δ j])]"
using chg
by (metis SG_dec close_nonmember_eq member_rec(1) member_rec(2))
have big_sound:"sound ([([], [nth Δ j])], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
by (metis (no_types, lifting) Rrule_CohideRR.prems(2) SG_dec and_foldl_sem_conv length_greater_0_conv less_or_eq_imp_le list.distinct(1) member_rec(2) member_singD nth_Cons_0 nth_member or_foldl_sem or_foldl_sem_conv seq_MP snd_conv)
show ?case
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
using res_eq
apply(unfold res_eq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using big_sound SG_dec
apply(cases "[nth Δ j] = Δ")
apply(auto)
using chg by (metis)+
next
case (Rrule_True SG i j C)
assume tt:"snd (SG ! i) ! j = TT"
assume iL:"i < length SG"
assume iJ:"j < length (snd (SG ! i))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have "⋀I ν. is_interp I ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
proof -
fix I::"('sf,'sc,'sz)interp" and ν::"'sz state"
assume good:"is_interp I"
have mem2:"List.member Δ (Δ ! j)"
using iJ nth_member
by (metis SG_dec snd_conv)
then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using mem2
using or_foldl_sem
by (metis SG_dec UNIV_I snd_conv tt tt_sem)
qed
then have seq_valid:"seq_valid (SG ! i)"
unfolding seq_valid_def using SG_dec
by (metis UNIV_eq_I seq_semI')
show ?case
using closeI_valid_sound[OF sound seq_valid]
by (simp add: sound_weaken_appR)
next
case (Rrule_Equiv SG i j C p q)
assume eq:"snd (SG ! i) ! j = (p ↔ q)"
assume iL:"i < length SG"
assume jL:"j < length (snd (SG ! i))"
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have equivR_simp:"⋀Γ Δ SS p q.
(nth Δ j) = Equiv p q ⟹
(Γ,Δ) = SS ⟹
Rrule_result EquivR j SS = [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))]"
subgoal for AI SI SS p q apply(cases SS) by (auto simp add: Equiv_def Implies_def Or_def) done
have res_eq:"Rrule_result EquivR j (SG ! i) =
[(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))]"
apply(rule equivR_simp)
subgoal using eq SG_dec by (metis snd_conv)
by (rule SG_dec)
have AIjeq:"Δ ! j = (p ↔ q)"
using SG_dec eq snd_conv
by metis
have close_eq:"close [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))] (Γ,Δ) = [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))]"
apply(rule close_nonmember_eq)
by (simp add: member_rec)
have big_sound:"sound ([(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))], (Γ,Δ))"
apply(rule soundI')
apply(rule seq_semI')
proof -
fix I ::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good:"is_interp I"
assume sgs:"(⋀i. 0 ≤ i ⟹ i < length [(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))] ⟹ ν ∈ seq_sem I ([(p # Γ, q # (closeI Δ j)), (q # Γ, p # (closeI Δ j))] ! i))"
have sg1:"ν ∈ seq_sem I (p # Γ, q # close Δ (Δ ! j))" using sgs[of 0] by auto
have sg2:"ν ∈ seq_sem I (q # Γ, p # (closeI Δ j))" using sgs[of 1] by auto
assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
have case1:"ν ∈ fml_sem I p ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
proof -
assume sem:"ν ∈ fml_sem I p"
have "ν ∈ fml_sem I (foldr (||) (q # (close Δ (nth Δ j))) FF)"
using sem Γ_sem sg1 by auto
then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using AIjeq SG_dec close_sub[of Δ "nth Δ j"] iff_sem[of "ν" I p q] jL local.sublist_def
member_rec(1)[of q "close Δ (nth Δ j)"] sem snd_conv
or_foldl_sem_conv[of ν I "q # close Δ (nth Δ j)"]
or_foldl_sem[of "Δ", where I=I and ν=ν]
nth_member[of j "snd (SG ! i)"]
by metis
qed
have case2:"ν ∉ fml_sem I p ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
proof -
assume sem:"ν ∉ fml_sem I p"
have "ν ∈ fml_sem I q ⟹ ν ∉ fml_sem I (foldr (||) Δ FF) ⟹ False"
using
and_foldl_sem[OF Γ_sem]
and_foldl_sem_conv
closeI.simps
close_sub
local.sublist_def
member_rec(1)[of "p" "closeI Δ j"]
member_rec(1)[of "q" "Γ"]
or_foldl_sem[of "Δ"]
or_foldl_sem_conv[of ν I "p # closeI Δ j"]
sem
sg2
seq_MP[of ν I "q # Γ" "p # closeI Δ j", OF sg2]
proof -
assume a1: "ν ∈ fml_sem I q"
assume a2: "ν ∉ fml_sem I (foldr (||) Δ FF)"
obtain ff :: "('sf, 'sc, 'sz) formula" where
"ν ∈ fml_sem I ff ∧ List.member (p # close Δ (Δ ! j)) ff"
using a1 by (metis (no_types) ‹⋀φ. List.member Γ φ ⟹ ν ∈ fml_sem I φ› ‹⋀y. List.member (q # Γ) y = (q = y ∨ List.member Γ y)› ‹ν ∈ fml_sem I (foldr (&&) (q # Γ) TT) ⟹ ν ∈ fml_sem I (foldr (||) (p # closeI Δ j) FF)› ‹ν ∈ fml_sem I (foldr (||) (p # closeI Δ j) FF) ⟹ ∃φ. ν ∈ fml_sem I φ ∧ List.member (p # closeI Δ j) φ› and_foldl_sem_conv closeI.simps)
then show ?thesis
using a2 by (metis (no_types) ‹⋀φ ν I. ⟦List.member Δ φ; ν ∈ fml_sem I φ⟧ ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)› ‹⋀y. List.member (p # closeI Δ j) y = (p = y ∨ List.member (closeI Δ j) y)› closeI.simps close_sub local.sublist_def sem)
qed
show "ν ∈ fml_sem I (foldr (||) Δ FF)"
by (metis AIjeq SG_dec ‹⟦ν ∈ fml_sem I q; ν ∉ fml_sem I (foldr (||) Δ FF)⟧ ⟹ False› iff_sem jL nth_member or_foldl_sem sem snd_eqD)
qed
show "ν ∈ fml_sem I (foldr (||) Δ FF)"
by(cases "ν ∈ fml_sem I p", (simp add: case1 case2)+)
qed
show ?case
apply(rule close_provable_sound)
apply(rule sound_weaken_appR)
apply(rule sound)
using res_eq
apply(unfold res_eq)
unfolding close_app_comm
apply (rule sound_weaken_appL)
using close_eq big_sound SG_dec AIjeq
by (simp add: AIjeq)
qed
lemma step_sound:"step_ok R i S ⟹ i ≥ 0 ⟹ i < length (fst R) ⟹ sound R ⟹ sound (step_result R (i,S))"
proof(induction rule: step_ok.induct)
case (Step_Axiom SG i a C)
assume is_axiom:"SG ! i = ([], [get_axiom a])"
assume sound:"sound (SG, C)"
assume i0:"0 ≤ i"
assume "i < length (fst (SG, C))"
then have iL:"i < length (SG)"
by auto
have "seq_valid ([], [get_axiom a])"
apply(rule fml_seq_valid)
by(rule axiom_valid)
then have seq_valid:"seq_valid (SG ! i)"
using is_axiom by auto
then show ?case
using closeI_valid_sound[OF sound seq_valid] by simp
next
case (Step_AxSubst SG i a σ C)
assume is_axiom:"SG ! i = ([], [Fsubst (get_axiom a) σ])"
assume sound:"sound (SG, C)"
assume ssafe:"ssafe σ"
assume i0:"0 ≤ i"
assume Fadmit:"Fadmit σ (get_axiom a)"
assume "i < length (fst (SG, C))"
then have iL:"i < length (SG)"
by auto
have valid_axiom:"valid (get_axiom a)"
by(rule axiom_valid)
have subst_valid:"valid (Fsubst (get_axiom a) σ)"
apply(rule subst_fml_valid)
apply(rule Fadmit)
apply(rule axiom_safe)
apply(rule ssafe)
by(rule valid_axiom)
have "seq_valid ([], [(Fsubst (get_axiom a) σ)])"
apply(rule fml_seq_valid)
by(rule subst_valid)
then have seq_valid:"seq_valid (SG ! i)"
using is_axiom by auto
then show ?case
using closeI_valid_sound[OF sound seq_valid] by simp
next
case (Step_Lrule R i j L)
then show ?case
using lrule_sound
using step_result.simps(2) surj_pair
by simp
next
case (Step_Rrule R i SG j L)
then show ?case
using rrule_sound
using step_result.simps(2) surj_pair
by simp
next
case (Step_Cut φ i SG C)
assume safe:"fsafe φ"
assume "i < length (fst (SG, C))"
then have iL:"i < length SG" by auto
assume sound:"sound (SG, C)"
obtain Γ and Δ where SG_dec:"(Γ,Δ) = (SG ! i)"
by (metis seq2fml.cases)
have "sound ((φ # Γ, Δ) # (Γ, φ # Δ) # [y←SG . y ≠ SG ! i], C)"
apply(rule soundI_memv)
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume good:"is_interp I"
assume sgs:"(⋀φ' ν. List.member ((φ # Γ, Δ) # (Γ, φ # Δ) # [y←SG . y ≠ SG ! i]) φ' ⟹ ν ∈ seq_sem I φ')"
have sg1:"⋀ν. ν ∈ seq_sem I (φ # Γ, Δ)" using sgs by (meson member_rec(1))
have sg2:"⋀ν. ν ∈ seq_sem I (Γ, φ # Δ)" using sgs by (meson member_rec(1))
have sgs:"⋀φ ν. (List.member (close SG (nth SG i)) φ) ⟹ ν ∈ seq_sem I φ"
using sgs by (simp add: member_rec(1))
then have sgs:"⋀φ ν. (List.member (close SG (Γ,Δ)) φ) ⟹ ν ∈ seq_sem I φ"
using SG_dec by auto
have sgNew:"⋀ν. ν ∈ seq_sem I (Γ, Δ)"
using sg1 sg2 by auto
have same_mem:"⋀x. List.member SG x ⟹ List.member ((Γ,Δ) # close SG (Γ,Δ)) x"
subgoal for s
by(induction SG, auto simp add: member_rec)
done
have SGS:"(⋀φ' ν. List.member SG φ' ⟹ ν ∈ seq_sem I φ')"
using sgNew sgs same_mem member_rec(1) seq_MP
by metis
show "ν ∈ seq_sem I C"
using sound apply simp
apply(drule soundD_memv)
apply(rule good)
using SGS
apply blast
by auto
qed
then show ?case
using SG_dec case_prod_conv
proof -
have "(⋀f. ((case nth SG i of (x, xa) ⇒ ((f x xa)::('sf, 'sc, 'sz) rule)) = (f Γ Δ)))"
by (metis (no_types) SG_dec case_prod_conv)
then show ?thesis
by (simp add: ‹sound ((φ # Γ, Δ) # (Γ, φ # Δ) # [y←SG . y ≠ SG ! i], C)›)
qed
next
case (Step_G SG i C a p)
assume eq:"SG ! i = ([], [([[a]]p)])"
assume iL:"i < length (fst (SG, C))"
assume sound:"sound (SG, C)"
have "sound (([], [p]) # (close SG ([], [([[ a ]] p)])), C)"
apply(rule soundI_memv)
proof -
fix I::"('sf,'sc,'sz) interp" and ν::"'sz state"
assume "is_interp I"
assume sgs:"(⋀φ ν. List.member (([], [p]) # close SG ([], [([[a]]p)])) φ ⟹ ν ∈ seq_sem I φ)"
have sg0:"(⋀ν. ν ∈ seq_sem I ([], [p]))"
using sgs by (meson member_rec(1))
then have sg0':"(⋀ν. ν ∈ seq_sem I ([], [([[a]]p)]))"
by auto
have sgTail:"(⋀φ ν. List.member (close SG ([], [([[a]]p)])) φ ⟹ ν ∈ seq_sem I φ)"
using sgs by (simp add: member_rec(1))
have same_mem:"⋀x. List.member SG x ⟹ List.member (([], [([[a]]p)]) # close SG ([], [([[a]]p)])) x"
subgoal for s
by(induction SG, auto simp add: member_rec)
done
have sgsC:"(⋀φ ν. List.member SG φ ⟹ ν ∈ seq_sem I φ)"
apply auto
using sgTail sg0' same_mem member_rec
by (metis seq_MP)
then show "ν ∈ seq_sem I C"
using sound
by (metis UNIV_eq_I ‹is_interp I› iso_tuple_UNIV_I soundD_mem)
qed
then show ?case
by(auto simp add: eq Box_def)
next
case (Step_CloseId SG i j k C)
assume match:"fst (SG ! i) ! j = snd (SG ! i) ! k"
assume jL:"j < length (fst (SG ! i))"
assume kL:"k < length (snd (SG ! i))"
assume iL:"i < length (fst (SG, C))"
then have iL:"i < length (SG)"
by auto
assume sound:"sound (SG, C)"
obtain Γ Δ where SG_dec:"(Γ, Δ) = SG ! i"
using prod.collapse by blast
have jΓ:"j < length Γ"
using SG_dec jL
by (metis fst_conv)
have kΔ:"k < length Δ"
using SG_dec kL
by (metis snd_conv)
have "⋀I ν. is_interp I ⟹ ν ∈ fml_sem I (foldr (&&) Γ TT) ⟹ ν ∈ fml_sem I (foldr (||) Δ FF)"
proof -
fix I::"('sf,'sc,'sz)interp" and ν::"'sz state"
assume good:"is_interp I"
assume Γ_sem:"ν ∈ fml_sem I (foldr (&&) Γ TT)"
have mem:"List.member Γ (Γ ! j)"
using jΓ nth_member by blast
have mem2:"List.member Δ (Δ ! k)"
using kΔ nth_member by blast
have "ν ∈ fml_sem I (Γ ! j)"
using Γ_sem mem
using and_foldl_sem by blast
then have "ν ∈ fml_sem I (Δ ! k)"
using match SG_dec
by (metis fst_conv snd_conv)
then show "ν ∈ fml_sem I (foldr (||) Δ FF)"
using mem2
using or_foldl_sem by blast
qed
then have seq_valid:"seq_valid (SG ! i)"
unfolding seq_valid_def using SG_dec
by (metis UNIV_eq_I seq_semI')
then show "sound (step_result (SG, C) (i, CloseId j k))"
using closeI_valid_sound[OF sound seq_valid] by simp
next
case (Step_DEAxiom_schema SG i ODE σ C )
assume isNth:"nth SG i =
([], [Fsubst (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1)) σ])"
assume FA:"Fadmit σ
(([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
assume disj:"{Inl vid1, Inr vid1} ∩ BVO ODE = {}"
have schem_valid:"valid (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]] (P pid1)) ↔
([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1))ODE)) (p1 vid2 vid1)]]
[[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))"
using DE_sys_valid[OF disj] by auto
assume ssafe:"ssafe σ"
assume osafe:"osafe ODE"
have subst_valid:"valid (Fsubst (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1)) σ)"
apply(rule subst_fml_valid)
apply(rule FA)
subgoal using disj by(auto simp add: f1_def Box_def p1_def P_def Equiv_def Or_def expand_singleton osafe, induction ODE, auto)
subgoal by (rule ssafe)
by (rule schem_valid)
assume "0 ≤ i"
assume "i < length (fst (SG, C))"
assume sound:"sound (SG, C)"
have "seq_valid ([], [(Fsubst (([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]]P pid1) ↔
([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1))ODE) (p1 vid2 vid1)]][[DiffAssign vid1 (f1 fid1 vid1)]]P pid1)) σ)])"
apply(rule fml_seq_valid)
by(rule subst_valid)
then have seq_valid:"seq_valid (SG ! i)"
using isNth by auto
then show ?case
using closeI_valid_sound[OF sound seq_valid] by simp
next
case (Step_CE SG i φ ψ σ C)
assume isNth:"SG ! i = ([], [Fsubst (InContext pid1 φ ↔ InContext pid1 ψ) σ])"
assume valid:"valid (φ ↔ ψ)"
assume FA:"Fadmit σ (InContext pid1 φ ↔ InContext pid1 ψ)"
assume "0 ≤ i"
assume "i < length (fst (SG, C))"
assume sound:"sound (SG, C)"
assume fsafe1:"fsafe φ"
assume fsafe2:"fsafe ψ"
assume ssafe:"ssafe σ"
have schem_valid:"valid (InContext pid1 φ ↔ InContext pid1 ψ)"
using valid unfolding valid_def
by (metis CE_holds_def CE_sound fml_sem.simps(7) iff_sem surj_pair valid_def)+
have subst_valid:"valid (Fsubst (InContext pid1 φ ↔ InContext pid1 ψ) σ)"
apply(rule subst_fml_valid)
apply(rule FA)
subgoal by(auto simp add: f1_def Box_def p1_def P_def Equiv_def Or_def expand_singleton fsafe1 fsafe2)
subgoal by (rule ssafe)
by (rule schem_valid)
have "seq_valid ([], [Fsubst (InContext pid1 φ ↔ InContext pid1 ψ) σ])"
apply(rule fml_seq_valid)
by(rule subst_valid)
then have seq_valid:"seq_valid (SG ! i)"
using isNth by auto
show "sound (step_result (SG, C) (i, CE φ ψ σ))"
using closeI_valid_sound[OF sound seq_valid] by simp
next
case (Step_CQ SG i p θ θ' σ C)
assume isNth:"nth SG i = ([], [Fsubst (Equiv (Prop p (singleton θ)) (Prop p (singleton θ'))) σ])"
assume valid:"valid (Equals θ θ')"
assume FA:"Fadmit σ ($φ p (singleton θ) ↔ $φ p (singleton θ'))"
assume "0 ≤ i"
assume "i < length (fst (SG, C))"
assume sound:"sound (SG, C)"
assume dsafe1:"dsafe θ"
assume dsafe2:"dsafe θ'"
assume ssafe:"ssafe σ"
have schem_valid:"valid ($φ p (singleton θ) ↔ $φ p (singleton θ'))"
using valid unfolding valid_def
by (metis CQ_holds_def CQ_sound fml_sem.simps(7) iff_sem surj_pair valid_def)+
have subst_valid:"valid (Fsubst ($φ p (singleton θ) ↔ $φ p (singleton θ')) σ)"
apply(rule subst_fml_valid)
apply(rule FA)
using schem_valid ssafe by (auto simp add: f1_def Box_def p1_def P_def Equiv_def Or_def expand_singleton dsafe1 dsafe2 expand_singleton)
have "seq_valid ([], [Fsubst ($φ p (singleton θ) ↔ $φ p (singleton θ')) σ])"
apply(rule fml_seq_valid)
by(rule subst_valid)
then have seq_valid:"seq_valid (SG ! i)"
using isNth by auto
show "sound (step_result (SG, C) (i, CQ θ θ' σ))"
using closeI_valid_sound[OF sound seq_valid] by simp
qed
lemma deriv_sound:"deriv_ok R D ⟹ sound R ⟹ sound (deriv_result R D)"
apply(induction rule: deriv_ok.induct)
using step_sound by auto
lemma proof_sound:"proof_ok Pf ⟹ sound (proof_result Pf)"
apply(induct rule: proof_ok.induct)
unfolding proof_result.simps apply(rule deriv_sound)
apply assumption
by(rule start_proof_sound)
section ‹Example 1: Differential Invariants›
definition DIAndConcl::"('sf,'sc,'sz) sequent"
where "DIAndConcl = ([], [Implies (And (Predicational pid1) (Predicational pid2))
(Implies ([[Pvar vid1]](And (Predicational pid3) (Predicational pid4)))
([[Pvar vid1]](And (Predicational pid1) (Predicational pid2))))])"
definition DIAndSG1::"('sf,'sc,'sz) formula"
where "DIAndSG1 = (Implies (Predicational pid1) (Implies ([[Pvar vid1]](Predicational pid3)) ([[Pvar vid1]](Predicational pid1))))"
definition DIAndSG2::"('sf,'sc,'sz) formula"
where "DIAndSG2 = (Implies (Predicational pid2) (Implies ([[Pvar vid1]](Predicational pid4)) ([[Pvar vid1]](Predicational pid2))))"
definition DIAndCut::"('sf,'sc,'sz) formula"
where "DIAndCut =
(([[$α vid1]]((And (Predicational ( pid3)) (Predicational ( pid4)))) → (And (Predicational ( pid1)) (Predicational ( pid2))))
→ ([[$α vid1]](And (Predicational ( pid3)) (Predicational ( pid4)))) → ([[$α vid1]](And (Predicational (pid1)) (Predicational ( pid2)))))"
definition DIAndSubst::"('sf,'sc,'sz) subst"
where "DIAndSubst =
⦇ SFunctions = (λ_. None),
SPredicates = (λ_. None),
SContexts = (λC. (if C = pid1 then Some(And (Predicational (Inl pid3)) (Predicational (Inl pid4)))
else (if C = pid2 then Some(And (Predicational (Inl pid1)) (Predicational (Inl pid2))) else None))),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition DIAndSubst341::"('sf,'sc,'sz) subst"
where "DIAndSubst341 =
⦇ SFunctions = (λ_. None),
SPredicates = (λ_. None),
SContexts = (λC. (if C = pid1 then Some(And (Predicational (Inl pid3)) (Predicational (Inl pid4)))
else (if C = pid2 then Some(Predicational (Inl pid3)) else None))),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition DIAndSubst342::"('sf,'sc,'sz) subst"
where "DIAndSubst342 =
⦇ SFunctions = (λ_. None),
SPredicates = (λ_. None),
SContexts = (λC. (if C = pid1 then Some(And (Predicational (Inl pid3)) (Predicational (Inl pid4)))
else (if C = pid2 then Some(Predicational (Inl pid4)) else None))),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition DIAndSubst12::"('sf,'sc,'sz) subst"
where "DIAndSubst12 =
⦇ SFunctions = (λ_. None),
SPredicates = (λ_. None),
SContexts = (λC. (if C = pid1 then Some(Predicational (Inl pid2))
else (if C = pid2 then Some(Predicational (Inl pid1) && Predicational (Inl pid2)) else None))),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition DIAndCurry12::"('sf,'sc,'sz) subst"
where "DIAndCurry12 =
⦇ SFunctions = (λ_. None),
SPredicates = (λ_. None),
SContexts = (λC. (if C = pid1 then Some(Predicational (Inl pid1))
else (if C = pid2 then Some(Predicational (Inl pid2) → (Predicational (Inl pid1) && Predicational (Inl pid2))) else None))),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition DIAnd :: "('sf,'sc,'sz) rule"
where "DIAnd =
([([],[DIAndSG1]),([],[DIAndSG2])],
DIAndConcl)"
definition DIAndCutP1 :: "('sf,'sc,'sz) formula"
where "DIAndCutP1 = ([[Pvar vid1]](Predicational pid1))"
definition DIAndCutP2 :: "('sf,'sc,'sz) formula"
where "DIAndCutP2 = ([[Pvar vid1]](Predicational pid2))"
definition DIAndCutP12 :: "('sf,'sc,'sz) formula"
where "DIAndCutP12 = (([[Pvar vid1]](Pc pid1) → (Pc pid2 → (And (Pc pid1) (Pc pid2))))
→ (([[Pvar vid1]]Pc pid1) → ([[Pvar vid1]](Pc pid2 → (And (Pc pid1) (Pc pid2))))))"
definition DIAndCut34Elim1 :: "('sf,'sc,'sz) formula"
where "DIAndCut34Elim1 = (([[Pvar vid1]](Pc pid3 && Pc pid4) → (Pc pid3))
→ (([[Pvar vid1]](Pc pid3 && Pc pid4)) → ([[Pvar vid1]](Pc pid3))))"
definition DIAndCut34Elim2 :: "('sf,'sc,'sz) formula"
where "DIAndCut34Elim2 = (([[Pvar vid1]](Pc pid3 && Pc pid4) → (Pc pid4))
→ (([[Pvar vid1]](Pc pid3 && Pc pid4)) → ([[Pvar vid1]](Pc pid4))))"
definition DIAndCut12Intro :: "('sf,'sc,'sz) formula"
where "DIAndCut12Intro = (([[Pvar vid1]](Pc pid2 → (Pc pid1 && Pc pid2)))
→ (([[Pvar vid1]](Pc pid2)) → ([[Pvar vid1]](Pc pid1 && Pc pid2))))"
definition DIAndProof :: "('sf, 'sc, 'sz) pf"
where "DIAndProof =
(DIAndConcl, [
(0, Rrule ImplyR 0)
,(0, Lrule AndL 0)
,(0, Rrule ImplyR 0)
,(0, Cut DIAndCutP1)
,(1, Cut DIAndSG1)
,(0, Rrule CohideR 0)
,(Suc (Suc 0), Lrule ImplyL 0)
,(Suc (Suc (Suc 0)), CloseId 1 0)
,(Suc (Suc 0), Lrule ImplyL 0)
,(Suc (Suc 0), CloseId 0 0)
,(Suc (Suc 0), Cut DIAndCut34Elim1)
,(0, Lrule ImplyL 0)
,(Suc (Suc (Suc 0)), Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(0, Rrule CohideRR 0)
,(Suc 0, Rrule CohideRR 0)
,(Suc (Suc (Suc (Suc (Suc 0)))), G)
,(0, Rrule ImplyR 0)
,(Suc (Suc (Suc (Suc (Suc 0)))), Lrule AndL 0)
,(Suc (Suc (Suc (Suc (Suc 0)))), CloseId 0 0)
,(Suc (Suc (Suc 0)), AxSubst AK DIAndSubst341)
,(Suc (Suc 0), CloseId 0 0)
,(Suc 0, CloseId 0 0)
,(0, Cut DIAndCut12Intro)
,(Suc 0, Rrule CohideRR 0)
,(Suc (Suc 0), AxSubst AK DIAndSubst12)
,(0, Lrule ImplyL 0)
,(1, Lrule ImplyL 0)
,(Suc (Suc 0), CloseId 0 0)
,(Suc 0, Cut DIAndCutP12)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(Suc (Suc (Suc (Suc 0))), AxSubst AK DIAndCurry12)
,(Suc (Suc (Suc 0)), Rrule CohideRR 0)
,(Suc (Suc 0), Lrule ImplyL 0)
,(Suc (Suc 0), G)
,(0, Rrule ImplyR 0)
,(Suc (Suc (Suc (Suc 0))), Rrule ImplyR 0)
,(Suc (Suc (Suc (Suc 0))), Rrule AndR 0)
,(Suc (Suc (Suc (Suc (Suc 0)))), CloseId 0 0)
,(Suc (Suc (Suc (Suc 0))), CloseId 1 0)
,(Suc (Suc 0), CloseId 0 0)
,(Suc 0, Cut DIAndCut34Elim2)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(Suc (Suc (Suc (Suc 0))), AxSubst AK DIAndSubst342)
,(Suc (Suc (Suc 0)), Rrule CohideRR 0)
,(Suc (Suc (Suc 0)), G)
,(0, Rrule ImplyR 0)
,(Suc (Suc (Suc 0)), Lrule AndL 0)
,(Suc (Suc (Suc 0)), CloseId 1 0)
,(Suc (Suc 0), Lrule ImplyL 0)
,(Suc 0, CloseId 0 0)
,(1, Cut DIAndSG2)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(Suc (Suc (Suc 0)), CloseId 4 0)
,(Suc (Suc 0), Lrule ImplyL 0)
,(Suc (Suc (Suc 0)), CloseId 0 0)
,(Suc (Suc (Suc 0)), CloseId 0 0)
,(1, CloseId 1 0)
])
"
fun proof_take :: "nat ⇒ ('sf,'sc,'sz) pf ⇒ ('sf,'sc,'sz) pf"
where "proof_take n (C,D) = (C,List.take n D)"
fun last_step::"('sf,'sc,'sz) pf ⇒ nat ⇒ nat * ('sf,'sc,'sz ) step"
where "last_step (C,D) n = List.last (take n D)"
lemma DIAndSound_lemma:"sound (proof_result (proof_take 61 DIAndProof))"
apply(rule proof_sound)
unfolding DIAndProof_def DIAndConcl_def DIAndCutP1_def DIAndSG1_def DIAndCut34Elim1_def DIAndSubst341_def DIAndCut12Intro_def DIAndSubst12_def
DIAndCutP12_def DIAndCurry12_def DIAndSubst342_def
DIAndCut34Elim2_def
DIAndSG2_def
apply (auto simp add: prover)
done
section ‹Example 2: Concrete Hybrid System›
definition SystemConcl::"('sf,'sc,'sz) sequent"
where "SystemConcl =
([],[
Implies (And (Geq (Var vid1) (Const 0)) (Geq (f0 fid1) (Const 0)))
([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (TT)]]Geq (Var vid1) (Const 0))
])"
definition SystemDICut :: "('sf,'sc,'sz) formula"
where "SystemDICut =
Implies
(Implies TT ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]]
(Geq (Differential (Var vid1)) (Differential (Const 0)))))
(Implies
(Implies TT (Geq (Var vid1) (Const 0)))
([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (Var vid1) (Const 0))))"
definition SystemDCCut::"('sf,'sc,'sz) formula"
where "SystemDCCut =
(([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (f0 fid1) (Const 0))) →
(([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]]((Geq (Differential (Var vid1)) (Differential (Const 0)))))
↔
([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]](Geq (Differential (Var vid1)) (Differential (Const 0))))))"
definition SystemVCut::"('sf,'sc,'sz) formula"
where "SystemVCut =
Implies (Geq (f0 fid1) (Const 0)) ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]](Geq (f0 fid1) (Const 0)))"
definition SystemVCut2::"('sf,'sc,'sz) formula"
where "SystemVCut2 =
Implies (Geq (f0 fid1) (Const 0)) ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) TT]](Geq (f0 fid1) (Const 0)))"
definition SystemDECut::"('sf,'sc,'sz) formula"
where "SystemDECut = (([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ((Geq (Differential (Var vid1)) (Differential (Const 0))))) ↔
([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]]
[[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))"
definition SystemKCut::"('sf,'sc,'sz) formula"
where "SystemKCut =
(Implies ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]]
(Implies ((And TT (Geq (f0 fid1) (Const 0)))) ([[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0))))))
(Implies ([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ((And TT (Geq (f0 fid1) (Const 0)))))
([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ([[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))))"
definition SystemEquivCut::"('sf,'sc,'sz) formula"
where "SystemEquivCut =
(Equiv (Implies ((And TT (Geq (f0 fid1) (Const 0)))) ([[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))
(Implies ((And TT (Geq (f0 fid1) (Const 0)))) ([[DiffAssign vid1 (f0 fid1)]](Geq (DiffVar vid1) (Const 0)))))"
definition SystemDiffAssignCut::"('sf,'sc,'sz) formula"
where "SystemDiffAssignCut =
(([[DiffAssign vid1 ($f fid1 empty)]] (Geq (DiffVar vid1) (Const 0)))
↔ (Geq ($f fid1 empty) (Const 0)))"
definition SystemCEFml1::"('sf,'sc,'sz) formula"
where "SystemCEFml1 = Geq (Differential (Var vid1)) (Differential (Const 0))"
definition SystemCEFml2::"('sf,'sc,'sz) formula"
where "SystemCEFml2 = Geq (DiffVar vid1) (Const 0)"
definition CQ1Concl::"('sf,'sc,'sz) formula"
where "CQ1Concl = (Geq (Differential (Var vid1)) (Differential (Const 0)) ↔ Geq (DiffVar vid1) (Differential (Const 0)))"
definition CQ2Concl::"('sf,'sc,'sz) formula"
where "CQ2Concl = (Geq (DiffVar vid1) (Differential (Const 0)) ↔ Geq ($' vid1) (Const 0))"
definition CEReq::"('sf,'sc,'sz) formula"
where "CEReq = (Geq (Differential (trm.Var vid1)) (Differential (Const 0)) ↔ Geq ($' vid1) (Const 0))"
definition CQRightSubst::"('sf,'sc,'sz) subst"
where "CQRightSubst =
⦇ SFunctions = (λ_. None),
SPredicates = (λp. (if p = vid1 then (Some (Geq (DiffVar vid1) (Function (Inr vid1) empty))) else None)),
SContexts = (λ_. None),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition CQLeftSubst::"('sf,'sc,'sz) subst"
where "CQLeftSubst =
⦇ SFunctions = (λ_. None),
SPredicates = (λp. (if p = vid1 then (Some (Geq (Function (Inr vid1) empty) (Differential (Const 0)))) else None)),
SContexts = (λ_. None),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition CEProof::"('sf,'sc,'sz) pf"
where "CEProof = (([],[CEReq]), [
(0, Cut CQ1Concl)
,(0, Cut CQ2Concl)
,(1, Rrule CohideRR 0)
,(Suc (Suc 0), CQ (Differential (Const 0)) (Const 0) CQRightSubst)
,(1, Rrule CohideRR 0)
,(1, CQ (Differential (Var vid1)) (DiffVar vid1) CQLeftSubst)
,(0, Rrule EquivR 0)
,(0, Lrule EquivForwardL 1)
,(Suc (Suc 0), Lrule EquivForwardL 1)
,(Suc (Suc (Suc 0)), CloseId 0 0)
,(Suc (Suc 0), CloseId 0 0)
,(Suc 0, CloseId 0 0)
,(0, Lrule EquivBackwardL (Suc (Suc 0)))
,(0, CloseId 0 0)
,(0, Lrule EquivBackwardL (Suc 0))
,(0, CloseId 0 0)
,(0, CloseId 0 0)
])"
lemma CE_result_correct:"proof_result CEProof = ([],([],[CEReq]))"
unfolding CEProof_def CEReq_def CQ1Concl_def CQ2Concl_def Implies_def Or_def f0_def TT_def Equiv_def Box_def CQRightSubst_def
by (auto simp add: id_simps)
definition DiffConstSubst::"('sf,'sc,'sz) subst"
where "DiffConstSubst = ⦇
SFunctions = (λf. (if f = fid1 then (Some (Const 0)) else None)),
SPredicates = (λ_. None),
SContexts = (λ_. None),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
definition DiffConstProof::"('sf,'sc,'sz) pf"
where "DiffConstProof = (([],[(Equals (Differential (Const 0)) (Const 0))]), [
(0, AxSubst AdConst DiffConstSubst)])"
lemma diffconst_result_correct:"proof_result DiffConstProof = ([], ([],[Equals (Differential (Const 0)) (Const 0)]))"
by(auto simp add: prover DiffConstProof_def)
lemma diffconst_sound_lemma:"sound (proof_result DiffConstProof)"
apply(rule proof_sound)
unfolding DiffConstProof_def
by (auto simp add: prover DiffConstProof_def DiffConstSubst_def Equals_def empty_def TUadmit_def)
lemma valid_of_sound:"sound ([], ([],[φ])) ⟹ valid φ"
unfolding valid_def sound_def TT_def FF_def
apply (auto simp add: TT_def FF_def Or_def)
subgoal for I a b
apply(erule allE[where x=I])
by(auto)
done
lemma almost_diff_const_sound:"sound ([], ([], [Equals (Differential (Const 0)) (Const 0)]))"
using diffconst_result_correct diffconst_sound_lemma by simp
lemma almost_diff_const:"valid (Equals (Differential (Const 0)) (Const 0))"
using almost_diff_const_sound valid_of_sound by auto
lemma almost_diff_var:"valid (Equals (Differential (trm.Var vid1)) ($' vid1))"
using diff_var_axiom_valid unfolding diff_var_axiom_def by auto
lemma CESound_lemma:"sound (proof_result CEProof)"
apply(rule proof_sound)
unfolding CEProof_def CEReq_def CQ1Concl_def CQ2Concl_def Equiv_def CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton
diff_var_axiom_def
by (auto simp add: prover CEProof_def CEReq_def CQ1Concl_def CQ2Concl_def Equiv_def
CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton
TUadmit_def NTUadmit_def almost_diff_const CQLeftSubst_def almost_diff_var)
lemma sound_to_valid:"sound ([], ([], [φ])) ⟹ valid φ"
unfolding valid_def apply auto
apply(drule soundD_mem)
by (auto simp add: member_rec(2))
lemma CE1pre:"sound ([], ([], [CEReq]))"
using CE_result_correct CESound_lemma
by simp
lemma CE1pre_valid:"valid CEReq"
by (rule sound_to_valid[OF CE1pre])
lemma CE1pre_valid2:"valid (! (! (Geq (Differential (trm.Var vid1)) (Differential (Const 0)) && Geq ($' vid1) (Const 0)) &&
! (! (Geq (Differential (trm.Var vid1)) (Differential (Const 0))) && ! (Geq ($' vid1) (Const 0))))) "
using CE1pre_valid unfolding CEReq_def Equiv_def Or_def by auto
definition SystemDISubst::"('sf,'sc,'sz) subst"
where "SystemDISubst =
⦇ SFunctions = (λf.
( if f = fid1 then Some(Function (Inr vid1) empty)
else if f = fid2 then Some(Const 0)
else None)),
SPredicates = (λp. if p = vid1 then Some TT else None),
SContexts = (λ_. None),
SPrograms = (λ_. None),
SODEs = (λc. if c = vid1 then Some (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (trm.Var vid1))) else None)
⦈"
definition SystemDCSubst::"('sf,'sc,'sz) subst"
where "SystemDCSubst =
⦇ SFunctions = (λ
f. None),
SPredicates = (λp. None),
SContexts = (λC.
if C = pid1 then
Some TT
else if C = pid2 then
Some (Geq (Differential (Var vid1)) (Differential (Const 0)))
else if C = pid3 then
Some (Geq (Function fid1 empty) (Const 0))
else
None),
SPrograms = (λ_. None),
SODEs = (λc. if c = vid1 then Some (OProd (OSing vid1 (Function fid1 empty)) (OSing vid2 (trm.Var vid1))) else None)
⦈"
definition SystemVSubst::"('sf,'sc,'sz) subst"
where "SystemVSubst =
⦇ SFunctions = (λf. None),
SPredicates = (λp. if p = vid1 then Some (Geq (Function (Inl fid1) empty) (Const 0)) else None),
SContexts = (λ_. None),
SPrograms = (λa. if a = vid1 then
Some (EvolveODE (OProd
(OSing vid1 (Function fid1 empty))
(OSing vid2 (Var vid1)))
(And TT (Geq (Function fid1 empty) (Const 0))))
else None),
SODEs = (λ_. None)
⦈"
definition SystemVSubst2::"('sf,'sc,'sz) subst"
where "SystemVSubst2 =
⦇ SFunctions = (λf. None),
SPredicates = (λp. if p = vid1 then Some (Geq (Function (Inl fid1) empty) (Const 0)) else None),
SContexts = (λ_. None),
SPrograms = (λa. if a = vid1 then
Some (EvolveODE (OProd
(OSing vid1 (Function fid1 empty))
(OSing vid2 (Var vid1)))
TT)
else None),
SODEs = (λ_. None)
⦈"
definition SystemDESubst::"('sf,'sc,'sz) subst"
where "SystemDESubst =
⦇ SFunctions = (λf. if f = fid1 then Some(Function (Inl fid1) empty) else None),
SPredicates = (λp. if p = vid2 then Some(And TT (Geq (Function (Inl fid1) empty) (Const 0))) else None),
SContexts = (λC. if C = pid1 then Some(Geq (Differential (Var vid1)) (Differential (Const 0))) else None),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
lemma systemdesubst_correct:"∃ ODE.(([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]] ((Geq (Differential (Var vid1)) (Differential (Const 0))))) ↔
([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (And TT (Geq (f0 fid1) (Const 0)))]]
[[DiffAssign vid1 (f0 fid1)]](Geq (Differential (Var vid1)) (Differential (Const 0)))))
= Fsubst ((([[EvolveODE (OProd (OSing vid1 (f1 fid1 vid1)) ODE) (p1 vid2 vid1)]] (P pid1)) ↔
([[EvolveODE ((OProd (OSing vid1 (f1 fid1 vid1))) ODE) (p1 vid2 vid1)]]
[[DiffAssign vid1 (f1 fid1 vid1)]]P pid1))) SystemDESubst"
apply(rule exI[where x="OSing vid2 (trm.Var vid1)"])
by(auto simp add: f0_def f1_def Box_def Or_def Equiv_def empty_def TT_def P_def p1_def SystemDESubst_def empty_def)
definition SystemKSubst::"('sf,'sc,'sz) subst"
where "SystemKSubst = ⦇ SFunctions = (λf. None),
SPredicates = (λ_. None),
SContexts = (λC. if C = pid1 then
(Some (And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))))
else if C = pid2 then
(Some ([[DiffAssign vid1 (Function fid1 empty)]](Geq (Differential (Var vid1)) (Differential (Const 0))))) else None),
SPrograms = (λc. if c = vid1 then Some (EvolveODE (OProd (OSing vid1 (Function fid1 empty)) (OSing vid2 (Var vid1))) (And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0)))) else None),
SODEs = (λ_. None)
⦈"
lemma subst_imp_simp:"Fsubst (Implies p q) σ = (Implies (Fsubst p σ) (Fsubst q σ))"
unfolding Implies_def Or_def by auto
lemma subst_equiv_simp:"Fsubst (Equiv p q) σ = (Equiv (Fsubst p σ) (Fsubst q σ))"
unfolding Implies_def Or_def Equiv_def by auto
lemma subst_box_simp:"Fsubst (Box p q) σ = (Box (Psubst p σ) (Fsubst q σ))"
unfolding Box_def Or_def by auto
lemma pfsubst_box_simp:"PFsubst (Box p q) σ = (Box (PPsubst p σ) (PFsubst q σ))"
unfolding Box_def Or_def by auto
lemma pfsubst_imp_simp:"PFsubst (Implies p q) σ = (Implies (PFsubst p σ) (PFsubst q σ))"
unfolding Box_def Implies_def Or_def by auto
definition SystemDWSubst::"('sf,'sc,'sz) subst"
where "SystemDWSubst = ⦇ SFunctions = (λf. None),
SPredicates = (λ_. None),
SContexts = (λC. if C = pid1 then Some (And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) else None),
SPrograms = (λ_. None),
SODEs = (λc. if c = vid1 then Some (OProd (OSing vid1 (Function fid1 empty)) (OSing vid2 (Var vid1))) else None)
⦈"
definition SystemCESubst::"('sf,'sc,'sz) subst"
where "SystemCESubst = ⦇ SFunctions = (λf. None),
SPredicates = (λ_. None),
SContexts = (λC. if C = pid1 then Some(Implies(And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) ([[DiffAssign vid1 (Function fid1 empty)]](Predicational (Inr ())))) else None),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
lemma SystemCESubstOK:
"step_ok
([([],[Equiv (Implies(And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) ([[DiffAssign vid1 (Function fid1 empty)]]( SystemCEFml1)))
(Implies(And (Geq (Const 0) (Const 0)) (Geq (Function fid1 empty) (Const 0))) ([[DiffAssign vid1 (Function fid1 empty)]]( (SystemCEFml2))))
])],
([],[]))
0
(CE SystemCEFml1 SystemCEFml2 SystemCESubst)"
apply(rule Step_CE)
subgoal by(auto simp add: subst_equiv_simp subst_imp_simp subst_box_simp SystemCESubst_def SystemCEFml1_def SystemCEFml2_def pfsubst_imp_simp pfsubst_box_simp)
subgoal using CE1pre_valid
by (auto simp add: CEReq_def SystemCEFml1_def SystemCEFml2_def CE1pre_valid)
subgoal unfolding SystemCEFml1_def by auto
subgoal unfolding SystemCEFml2_def by auto
subgoal unfolding SystemCESubst_def ssafe_def Implies_def Box_def Or_def empty_def by auto
unfolding SystemCESubst_def Equiv_def Or_def SystemCEFml1_def SystemCEFml2_def TUadmit_def apply (auto simp add: TUadmit_def FUadmit_def Box_def Implies_def Or_def)
unfolding PFUadmit_def by auto
definition SystemDiffAssignSubst::"('sf,'sc,'sz) subst"
where "SystemDiffAssignSubst = ⦇ SFunctions = (λf. None),
SPredicates = (λp. if p = vid1 then Some (Geq (Function (Inr vid1) empty) (Const 0)) else None),
SContexts = (λ_. None),
SPrograms = (λ_. None),
SODEs = (λ_. None)
⦈"
lemma SystemDICutCorrect:"SystemDICut = Fsubst DIGeqaxiom SystemDISubst"
unfolding SystemDICut_def DIGeqaxiom_def SystemDISubst_def
by (auto simp add: f1_def p1_def f0_def Implies_def Or_def id_simps TT_def Box_def empty_def)
definition SystemProof :: "('sf, 'sc, 'sz) pf"
where "SystemProof =
(SystemConcl, [
(0, Rrule ImplyR 0)
,(0, Lrule AndL 0)
,(0, Cut SystemDICut)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(0, Lrule ImplyL 0)
,(Suc (Suc 0), CloseId 0 0)
,(Suc 0, AxSubst ADIGeq SystemDISubst)
,(Suc 0, Rrule ImplyR 0)
,(Suc 0, CloseId 1 0)
,(0, Rrule ImplyR 0)
,(0, Cut SystemDCCut)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(0, Lrule EquivBackwardL 0)
,(0, Rrule CohideR 0)
,(0, AxSubst ADC SystemDCSubst)
,(0, CloseId 0 0)
,(0, Rrule CohideRR 0)
,(0, Cut SystemVCut)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(0, Cut SystemDECut)
,(0, Lrule EquivBackwardL 0)
,(0, Rrule CohideRR 0)
,(1, CloseId (Suc 1) 0)
,(Suc 1, CloseId 0 0)
,(1, AxSubst AV SystemVSubst)
,(0, Cut SystemVCut2)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(Suc 1, CloseId 0 0)
,(Suc 1, CloseId (Suc 2) 0)
,(Suc 1, AxSubst AV SystemVSubst2)
,(0, Rrule CohideRR 0)
,(0, DEAxiomSchema (OSing vid2 (trm.Var vid1)) SystemDESubst)
,(0, Cut SystemKCut)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(0, Lrule ImplyL 0)
,(0, Rrule CohideRR 0)
,(0, AxSubst AK SystemKSubst)
,(0, CloseId 0 0)
,(0, Rrule CohideR 0)
,(1, AxSubst ADW SystemDWSubst)
,(0, G)
,(0, Cut SystemEquivCut)
,(0, Lrule EquivBackwardL 0)
,(0, Rrule CohideR 0)
,(0, CloseId 0 0)
,(0, Rrule CohideR 0)
,(0, CE SystemCEFml1 SystemCEFml2 SystemCESubst)
,(0, Rrule ImplyR 0)
,(0, Lrule AndL 0)
,(0, Cut SystemDiffAssignCut)
,(0, Lrule EquivBackwardL 0)
,(0, Rrule CohideRR 0)
,(0, CloseId 0 0)
,(0, CloseId 1 0)
,(0, AxSubst Adassign SystemDiffAssignSubst)
])"
lemma system_result_correct:"proof_result SystemProof =
([],
([],[Implies (And (Geq (Var vid1) (Const 0)) (Geq (f0 fid1) (Const 0)))
([[EvolveODE (OProd (OSing vid1 (f0 fid1)) (OSing vid2 (Var vid1))) (TT)]]Geq (Var vid1) (Const 0))]))"
unfolding SystemProof_def SystemConcl_def Implies_def Or_def f0_def TT_def Equiv_def SystemDICut_def SystemDCCut_def
proof_result.simps deriv_result.simps start_proof.simps Box_def SystemDCSubst_def SystemVCut_def SystemDECut_def SystemKCut_def SystemEquivCut_def
SystemDiffAssignCut_def SystemVCut2_def
apply( simp add: prover)
done
lemma SystemSound_lemma:"sound (proof_result SystemProof)"
apply(rule proof_sound)
unfolding SystemProof_def SystemConcl_def CQ1Concl_def CQ2Concl_def Equiv_def CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton
diff_var_axiom_def SystemDICut_def
apply (auto simp add: prover CEProof_def CEReq_def CQ1Concl_def CQ2Concl_def Equiv_def
CQRightSubst_def diff_const_axiom_valid diff_var_axiom_valid empty_def Or_def expand_singleton
TUadmit_def NTUadmit_def almost_diff_const CQLeftSubst_def almost_diff_var f0_def TT_def SystemDISubst_def f1_def p1_def SystemDCCut_def SystemDCSubst_def
SystemVCut_def SystemDECut_def SystemVSubst_def
SystemVCut2_def SystemVSubst2_def SystemDESubst_def P_def SystemKCut_def SystemKSubst_def SystemDWSubst_def SystemEquivCut_def
SystemCESubst_def SystemCEFml1_def SystemCEFml2_def CE1pre_valid2 SystemDiffAssignCut_def SystemDiffAssignSubst_def)
done
lemma system_sound:"sound ([], SystemConcl)"
using SystemSound_lemma system_result_correct unfolding SystemConcl_def by auto
lemma DIAnd_result_correct:"proof_result (proof_take 61 DIAndProof) = DIAnd"
unfolding DIAndProof_def DIAndConcl_def Implies_def Or_def
proof_result.simps deriv_result.simps start_proof.simps DIAndCutP12_def DIAndSG1_def DIAndSG2_def DIAndCutP1_def Box_def DIAndCut34Elim1_def DIAndCut12Intro_def DIAndCut34Elim2_def DIAnd_def
using pne12 pne13 pne14 pne23 pne24 pne34 by (auto)
theorem DIAnd_sound: "sound DIAnd"
using DIAndSound_lemma DIAnd_result_correct by auto
end end